home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / lang / FPL_v147.lha / fpl / src / script.c < prev    next >
C/C++ Source or Header  |  1996-08-21  |  81KB  |  2,650 lines
  1. /******************************************************************************
  2.  *              FREXX PROGRAMMING LANGUAGE                  *
  3.  ******************************************************************************
  4.  
  5.  script.c
  6.  
  7.  The main routine of the language. Handles all keywords, {'s and }'s.
  8.  
  9.  *****************************************************************************/
  10.  
  11. /************************************************************************
  12.  *                                                                      *
  13.  * fpl.library - A shared library interpreting script langauge.         *
  14.  * Copyright (C) 1992-1994 FrexxWare                                    *
  15.  * Author: Daniel Stenberg                                              *
  16.  *                                                                      *
  17.  * This program is free software; you may redistribute for non          *
  18.  * commercial purposes only. Commercial programs must have a written    *
  19.  * permission from the author to use FPL. FPL is *NOT* public domain!   *
  20.  * Any provided source code is only for reference and for assurance     *
  21.  * that users should be able to compile FPL on any operating system     *
  22.  * he/she wants to use it in!                                           *
  23.  *                                                                      *
  24.  * You may not change, resource, patch files or in any way reverse      *
  25.  * engineer anything in the FPL package.                                *
  26.  *                                                                      *
  27.  * This program is distributed in the hope that it will be useful,      *
  28.  * but WITHOUT ANY WARRANTY; without even the implied warranty of       *
  29.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                 *
  30.  *                                                                      *
  31.  * Daniel Stenberg                                                      *
  32.  * Ankdammsgatan 36, 4tr                                                *
  33.  * S-171 43 Solna                                                       *
  34.  * Sweden                                                               *
  35.  *                                                                      *
  36.  * FidoNet 2:201/328    email:dast@sth.frontec.se                       *
  37.  *                                                                      *
  38.  ************************************************************************/
  39.  
  40. #ifdef AMIGA
  41. #include <exec/types.h>
  42. #include <proto/exec.h>
  43. #include <libraries/dos.h>
  44. #include <proto/dos.h>
  45.  
  46. #include <exec/libraries.h>
  47. #include <dos.h>
  48.  
  49. #else
  50. #include <sys/types.h>
  51. #include <sys/stat.h>
  52. #ifdef SUNOS
  53. #include <varargs.h>
  54. #else
  55. #include <stdarg.h>
  56. #endif
  57. #endif
  58.  
  59. #include <stdlib.h> /* for the system() call i.e */
  60.  
  61. #include <stdio.h>
  62. #include <string.h>
  63. #include "script.h"
  64. #include "debug.h"
  65. #include "compile.h"
  66.  
  67. #ifdef DEBUG
  68. long mem=0;
  69. long maxmem=0;
  70. #endif
  71.  
  72. static ReturnCode INLINE AddProgram(struct Data *, struct Program **,
  73.                     uchar *, long, uchar *);
  74. static uchar REGARGS CheckIt(struct Data *, struct Expr *, short, ReturnCode *);
  75. static ReturnCode INLINE Declare(struct Expr *, struct Data *,
  76.                  struct Identifier *, long);
  77. static ReturnCode Go(struct Data *, struct Expr *val);
  78. static ReturnCode REGARGS Loop(struct Data *, struct Condition *, short, uchar *);
  79. static ReturnCode INLINE Resize(struct Data *, struct Expr *, uchar);
  80. static ReturnCode REGARGS SkipStatement(struct Data *);
  81. static ReturnCode REGARGS StoreGlobals(struct Data *, uchar);
  82. static ReturnCode REGARGS Run(struct Data *, uchar *, uchar *, long, unsigned long *);
  83. static ReturnCode INLINE Switch(struct Data *, struct Expr *, short,
  84.                                 struct Condition *);
  85. static REGARGS void StoreBeginning(struct Data *, char *, long);
  86. /*
  87.  * Global character flags:
  88.  */
  89.  
  90. const uchar type[257] = { /* Character type codes */
  91.    _C, /* -1 == regular ANSI C eof character */
  92.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 00        */
  93.    _C,    _S,      _S,     _C,    _C,    _S,    _C,    _C, /* 08        */
  94.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 10        */
  95.    _C,    _C,      _C,     _C,    _C,    _C,    _C,    _C, /* 18        */
  96.    _S,    _P,     _P,     _P,    _P,    _P,    _P,    _P, /* 20    !"#$%&' */
  97.    _P,    _P,     _P,    _P,    _P,    _P,    _P,    _P, /* 28 ()*+,-./ */
  98.  _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, _N|_X, /* 30 01234567 */
  99.  _N|_X, _N|_X,    _P,    _P,    _P,    _P,    _P,    _P, /* 38 89:;<=>? */
  100.    _P, _U|_X,  _U|_X, _U|_X, _U|_X, _U|_X, _U|_X,    _U, /* 40 @ABCDEFG */
  101.    _U,    _U,      _U,     _U,    _U,    _U,    _U,    _U, /* 48 HIJKLMNO */
  102.    _U,    _U,      _U,     _U,    _U,    _U,    _U,    _U, /* 50 PQRSTUVW */
  103.    _U,    _U,      _U,     _P,    _P,    _P,    _P, _P|_W, /* 58 XYZ[\]^_ */
  104.    _P, _L|_X,  _L|_X, _L|_X, _L|_X, _L|_X, _L|_X,    _L, /* 60 `abcdefg */
  105.    _L,    _L,      _L,     _L,    _L,    _L,    _L,    _L, /* 68 hijklmno */
  106.    _L,    _L,      _L,     _L,    _L,    _L,    _L,    _L, /* 70 pqrstuvw */
  107.    _L,    _L,      _L,     _P,    _P,    _P,    _P,   000, /* 78 xyz{|}~    */
  108.   000,   000,     000,    000,   000,   000,   000,   000, /* 80             */
  109.   000,   000,     000,    000,   000,   000,   000,   000, /* 88             */
  110.   000,   000,     000,    000,   000,   000,   000,   000, /* 90             */
  111.   000,   000,     000,    000,   000,   000,   000,   000, /* 98             */
  112.   000,   000,     000,    000,   000,   000,   000,   000, /* A0             */
  113.   000,   000,     000,    000,   000,   000,   000,   000, /* A8             */
  114.   000,   000,     000,    000,   000,   000,   000,   000, /* B0             */
  115.   000,   000,     000,    000,   000,   000,   000,   000, /* B8             */
  116.   000,   000,     000,    000,   000,   000,   000,   000, /* C0             */
  117.   000,   000,     000,    000,   000,   000,   000,   000, /* C8             */
  118.   000,   000,     000,    000,   000,   000,   000,   000, /* D0             */
  119.   000,   000,     000,    000,   000,   000,   000,   000, /* D8             */
  120.   000,   000,     000,    000,   000,   000,   000,   000, /* E0             */
  121.   000,   000,     000,    000,   000,   000,   000,   000, /* E8             */
  122.   000,   000,     000,    000,   000,   000,   000,   000, /* F0             */
  123.   000,   000,     000,    000,   000,   000,   000,   000, /* F8             */
  124. };
  125.  
  126. unsigned long inttags[]={FPLSEND_INT, 0, FPLSEND_DONE};
  127. unsigned long strtags[]={FPLSEND_STRING, 0,
  128.                          FPLSEND_STRLEN, 0,
  129.                          FPLSEND_DONTCOPY_STRING, TRUE,
  130.                          FPLSEND_DONE};
  131.  
  132. #ifndef AMIGA /* if not using SAS/C on Amiga */
  133.  
  134. /******************************************************/
  135. /* Parameter list frontends of the library functions: */
  136. /******************************************************/
  137.  
  138. #ifdef VARARG_FUNCTIONS
  139. long fplExecuteFileTags(void *anchor, uchar *program, ...)
  140. {
  141.   va_list tags;
  142.   long ret;
  143. #ifdef SUNOS
  144.   va_start(tags); /* get parameter list */
  145. #else
  146.   va_start(tags, program); /* get parameter list */
  147. #endif
  148.   ret = fplExecuteFile(anchor, program, (unsigned long *)tags);
  149.   va_end(tags);
  150.   return ret;
  151. }
  152. #else /* VARARG_FUNCTIONS */
  153. long fplExecuteFileTags(void *anchor, uchar *program, unsigned long tags, ...)
  154. {
  155.   return(fplExecuteFile(anchor, program, (unsigned long *)&tags));
  156. }
  157. #endif
  158.  
  159. #endif
  160.  
  161. /***************************************************************************
  162.  *
  163.  * fplExecuteFile()
  164.  *
  165.  * Executes the specified file as an FPL program.
  166.  *
  167.  ******/
  168.  
  169. ReturnCode PREFIX fplExecuteFile(AREG(0) struct Data *scr,
  170.                  AREG(1) uchar *filename,
  171.                  AREG(2) unsigned long *tags)
  172. {
  173. #ifdef DEBUGMAIL
  174.   DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteFile");
  175. #endif
  176.   return(Run(scr, filename, NULL, 1, tags));
  177. }
  178.  
  179.  
  180. #ifndef AMIGA /* if not using SAS/C on Amiga */
  181.  
  182. #ifdef VARARG_FUNCTIONS
  183. long fplExecuteScriptTags(void *anchor, uchar **program, long lines, ...)
  184. {
  185.   va_list tags;
  186.   long ret;
  187. #ifdef SUNOS
  188.   va_start(tags); /* get parameter list */
  189. #else
  190.   va_start(tags, lines); /* get parameter list */
  191. #endif
  192.   ret = fplExecuteScript(anchor, program, lines, (unsigned long *)tags);
  193.   va_end(tags);
  194.   return ret;
  195. }
  196. #else /* VARARG_FUNCTIONS */
  197.  
  198. long fplExecuteScriptTags(void *anchor, uchar **program, long lines,
  199.                           unsigned long tags, ...)
  200. {
  201.   return(fplExecuteScript(anchor, program, lines, (unsigned long *)&tags));
  202. }
  203. #endif
  204.  
  205. #endif
  206.  
  207. /**********************************************************************
  208.  *
  209.  * fplExecuteScript()
  210.  *
  211.  * Frontend to Run().
  212.  *
  213.  * The error code is returned to daddy...
  214.  *
  215.  ******/
  216.  
  217. ReturnCode PREFIX fplExecuteScript(AREG(0) struct Data *scr, /* nice struct */
  218.                    AREG(1) uchar **program, /* program array */
  219.                    DREG(1) long lines,     /* number of lines */
  220.                    AREG(2) unsigned long *tags)
  221. {
  222. #ifdef DEBUGMAIL
  223.   DebugMail(scr, MAIL_FUNCTION, 500, "fplExecuteScript");
  224. #endif
  225.   return(Run(scr, NULL, *program, lines, tags));
  226. }
  227.  
  228.  
  229. /**************************************************************************
  230.  *
  231.  * ReadFile()
  232.  *
  233.  *   Reads the specified file into memory, stores the pointer to the memory
  234.  * area in the pointer `program' points to, and the size of the memory area
  235.  * in the integer `size' points to. I decided to use a different way on Amiga
  236.  * to increase performance a lot.
  237.  *
  238.  *   This function first checks the size of the file it's about to fetch
  239.  * and then reads the entire file at once in one continuos memory area.
  240.  *
  241.  *   Returns the proper return code. If anything goes wrong, there won't be
  242.  * *ANY* program to look at (the pointer will be NULL, but the size will most
  243.  * probably still be correct which means a non-zero value). If this function
  244.  * fails it takes care of freeing the program memory by itself. You only have
  245.  * to free that memory if this functions reports success.
  246.  *
  247.  ********/
  248.  
  249. ReturnCode REGARGS
  250. ReadFile(void *fpl,
  251.          uchar *filename,
  252.          struct Program *prog)
  253. {
  254.   struct Data *scr=(struct Data *)fpl;
  255. #ifdef AMIGA  /* Amiga version. */
  256.   struct FileInfoBlock fileinfo;
  257.   struct FileLock *lock=NULL;
  258.   struct FileHandle *fileread;
  259.  
  260.   struct MyLibrary *lib = (struct MyLibrary *)getreg(REG_A6);
  261.   struct Library *DOSBase = lib->ml_DosBase;
  262. #else
  263.   FILE *stream;
  264.   struct stat statstr;
  265. #endif
  266.   ReturnCode ret=FPL_OK;
  267. #ifdef AMIGA
  268.  
  269.   if(filename && filename[0])
  270.     /* Lock on file */
  271.     lock=(struct FileLock *)Lock((UBYTE *)filename, ACCESS_READ);
  272.   if (lock) {
  273.     if (Examine((BPTR)lock, &fileinfo) && fileinfo.fib_Size) {
  274.       /*
  275.        * Only do this if the file was there, and it was larger than zero
  276.        * bytes!
  277.        */
  278.       prog->size = fileinfo.fib_Size+1; /* Add one for a terminating zero! */
  279.     } else
  280.       ret=FPLERR_OPEN_ERROR;    /* something went wrong */
  281.     UnLock((BPTR)lock);    /* release the lock of the file */
  282.   } else
  283.     ret=FPLERR_OPEN_ERROR;        /* we couldn't lock on the file */
  284. #elif defined(UNIX)
  285.   if (!(stream = fopen(filename, "r")))
  286.     ret=FPLERR_OPEN_ERROR;
  287.   else {
  288.     if(fseek(stream, 0, 2)) {
  289.       fclose(stream);
  290.       ret=FPLERR_OPEN_ERROR;
  291.     } else {
  292.       prog->size=ftell(stream)+1;
  293.       fseek(stream, 0, 0);
  294.     }
  295.   }
  296. #endif
  297.  
  298. #ifdef AMIGA
  299.   prog->date = GETFILEDATE(fileinfo);
  300. #else
  301.   if(!stat(filename, &statstr)) {
  302.     prog->date = statstr.st_mtime;
  303.   } else
  304.     ret=FPLERR_OPEN_ERROR;
  305. #endif
  306.  
  307.   if(ret)
  308.     return(ret);
  309.  
  310.   /* Open file for reading. */
  311. #ifdef AMIGA
  312.   /* We could use OpenFromLock() here, but it's a V36+ function! */
  313.   fileread=(struct FileHandle *)Open((UBYTE *)filename, MODE_OLDFILE);
  314. #elif defined(UNIX)
  315.   /* file is already opened! */
  316. #endif
  317.   prog->program=(uchar *)MALLOC(prog->size); /* Allocate memory for program. */
  318.   if(!prog->program) /* if we didn't get the requested memory: */
  319.     ret=FPLERR_OUT_OF_MEMORY;
  320. #ifdef AMIGA
  321.   else if(Read((BPTR)fileread, prog->program, (LONG)prog->size)<0) /* get entire file */
  322. #elif defined(UNIX)
  323.   else if(!fread(prog->program, 1, prog->size, stream))
  324. #endif
  325.     /* if we couldn't Read() the file: */
  326.     ret=FPLERR_OPEN_ERROR;
  327.   else
  328.     (prog->program)[prog->size-1]='\0'; /* add the terminating zero byte. */
  329. #ifdef AMIGA
  330.   Close((BPTR)fileread); /* close file */
  331. #elif defined(UNIX)
  332.   fclose(stream); /* close the stream */
  333. #endif
  334.   /* only if error and we could allocate the proper memory */
  335.   if(ret && prog->program) {
  336.     FREE(prog->program); /* free the, for the program allocated, memory */
  337.   }
  338.   return(ret); /* get back to parent */
  339. }
  340.  
  341. /**********************************************************************
  342.  *
  343.  * AddProgram();
  344.  *
  345.  * Adds a program to FPL's internal lists of program files.
  346.  *
  347.  ****/
  348.  
  349. static ReturnCode INLINE AddProgram(struct Data *scr,
  350.                     struct Program **get,
  351.                     uchar *program,
  352.                     long lines,
  353.                     uchar *name)
  354. {
  355.   struct Program *next, *prog=NULL;
  356.   ReturnCode ret;
  357.   long date=-1;
  358.   if(name && name[0]) {
  359.     /*
  360.      * Name was given. Search through the internals to see if
  361.      * we have this file cached already!
  362.      */
  363.     prog=scr->programs;
  364.     while(prog) {
  365.       if(prog->name && !strcmp(prog->name, name))
  366.     break;
  367.       prog=prog->next;
  368.     }
  369.   }
  370.   if(prog) {
  371.  
  372.     /*
  373.      * The program already exists.
  374.      */
  375.     if( (prog->flags & PR_REREAD_CHANGES) &&
  376.         (prog->flags & PR_NAME_IS_FILENAME) &&
  377.         !(prog->flags&PR_USERSUPPLIED) ) {
  378.  
  379.       timeoffile(date, name); /* big macro */
  380.  
  381.       /* Compare dates of internal program and actual file */
  382.       if(date != prog->date) {
  383.         /*
  384.          * The dates are different, flush all info that has to do with the
  385.          * file, and re-read it into memory!
  386.          */
  387.         unsigned long tags[]={FPLSEND_FREEFILE, 0, FPLSEND_DONE};
  388.         tags[1] = (unsigned long)name;
  389.         CALL(Send(scr, tags));
  390.         prog=NULL; /* force a insertion of this file again! */
  391.       }
  392.     }
  393.  
  394.     /*
  395.      * The very same good old program. If the FPLTAG_PREVENT_RUNNING_SAME
  396.      * was used, then abort here and now!
  397.      */
  398.     if(prog && scr->flags&FPLDATA_PREVENT_RUNNING_SAME) {
  399.       *get = NULL;
  400.       return FPL_OK;
  401.     }
  402.  
  403. /*
  404.  
  405.   These following actions don't have to be done!
  406.  
  407.     CALL(LeaveProgram(scr, scr->prog));
  408.     CALL(GetProgram(scr, prog));
  409. */
  410.   }
  411.  
  412.   if(!prog) {
  413.     GETMEMA(prog, sizeof(struct Program));
  414.     memset(prog, 0, sizeof(struct Program));
  415. #ifdef DEBUG
  416.     CheckMem(scr, prog);
  417. #endif
  418.     next=scr->programs;
  419.     prog->next=next;
  420.     prog->program=program;
  421.     prog->lines=lines;
  422.     prog->startprg=1;
  423.     prog->virprg=1;
  424.     prog->flags = (scr->flags&FPLDATA_REREAD_CHANGES?
  425.                     PR_REREAD_CHANGES:0)|
  426.                   (scr->flags&FPLDATA_FLUSH_NOT_IN_USE?
  427.                     PR_FLUSH_NOT_IN_USE:0)|
  428.           (scr->flags&FPLDATA_KIDNAP_CACHED?
  429.             PR_KIDNAP_CACHED:0);
  430.     if(program) {
  431.       SetupCompiled(prog);
  432.     }
  433.     if(name) {
  434.       STRDUPA(prog->name, name);
  435.     }
  436.     scr->programs=prog;
  437.   }
  438.  
  439.   scr->prog=prog;
  440.   *get=prog;
  441.   return(FPL_OK);
  442. }
  443.  
  444. /**********************************************************************
  445.  *
  446.  * DelProgram()
  447.  *
  448.  * Deletes a specifed program from memory. If NULL is specified where
  449.  * the program struct is supposed, all programs are removed! (Amiga
  450.  * version *have* to do that to UnLock() all files that might be locked
  451.  * when using the FPLTAG_LOCKUSED!
  452.  *
  453.  *******/
  454.  
  455. ReturnCode REGARGS
  456. DelProgram(struct Data *scr,
  457.            struct Program *del)
  458. {
  459.   struct Program *prog=scr->programs, *prev=NULL;
  460.   while(prog) { /* it must not be running! */
  461.     if((!del || prog==del) && !prog->running) {
  462.       if(prev)
  463.     prev->next=prog->next;
  464.       else
  465.     scr->programs=prog->next;
  466.       if(del && (scr->prog==del))
  467.     scr->prog=scr->prog->next;
  468.       prev=prog->next;
  469.       if(prog->name)
  470.     FREEA(prog->name);
  471.       if(!(prog->flags&PR_USERSUPPLIED) && prog->program) {
  472.         SwapMem(scr, prog->program, MALLOC_DYNAMIC);
  473.         FREE(prog->program);
  474.       }
  475.       FREEA(prog);
  476.       if(del)
  477.         break;
  478.       
  479.       prog=prev;
  480.       prev=NULL;
  481.  
  482.     }
  483.     else {
  484.       prev=prog;
  485.       prog=prog->next;
  486.     }
  487.   }
  488.   return(FPL_OK);
  489. }
  490. #if 1
  491. /**********************************************************************
  492.  *
  493.  * This program checks and autocompiles .FPC files older than the .FPL
  494.  * that is about to run.
  495.  */
  496.  
  497. ReturnCode FileCheck(struct Data *scr,
  498.                      char **filename,
  499.                      struct Program *prog)
  500. {
  501. #define SPACE_FOR_FPLC 0 /* strlen(COMPILE_COMMAND) */
  502.                          /* bytes needed to add "fplc " */
  503.   ReturnCode ret;
  504.   uchar *filebuffer;
  505.   uchar *file;
  506.   uchar ext;
  507.   long timethis;
  508.   long timethat;
  509.   long len=strlen(*filename); /* length of file name */
  510.   if(len >= 4) {
  511.     if(!my_memicmp(UNCOMPILED_EXTENSION,
  512.                    &(*filename)[len-strlen(UNCOMPILED_EXTENSION)],
  513.                    strlen(UNCOMPILED_EXTENSION)+1)) {
  514.       ext=1; /* it is a non-compiled extension */
  515.     }
  516.     else
  517.       ext = 0;
  518.     if(ext) {
  519.       GETMEM(filebuffer, len+1+SPACE_FOR_FPLC);
  520.       file = &filebuffer[SPACE_FOR_FPLC];
  521.  
  522.       timeoffile(timethis, prog->name); /* big macro */
  523.       
  524.       memcpy(file, *filename, len-strlen(COMPILED_EXTENSION));
  525.       memcpy(&file[len-strlen(COMPILED_EXTENSION)],
  526.              COMPILED_EXTENSION,
  527.              strlen(COMPILED_EXTENSION)+1);
  528.  
  529.       timeoffile(timethat, file); /* big macro */
  530.  
  531.       if(timethis > timethat) {
  532.         /* uncompiled is the newest, go with that! */
  533.         FREE(filebuffer);
  534.         return FPL_OK;
  535.       }
  536.       
  537.       /* run the compiled file */
  538.       prog->flags |= PR_SELECTED_FPC;
  539.       *filename = filebuffer;
  540.     }
  541.   }
  542.   return ret;
  543. }
  544.  
  545. #endif
  546.  
  547. /**********************************************************************
  548.  *
  549.  * Run()
  550.  *
  551.  *****/
  552.  
  553. static ReturnCode REGARGS
  554. Run(struct Data *scr,
  555.     uchar *filename,
  556.     uchar *program,
  557.     long lines,
  558.     unsigned long *tags)
  559. {
  560.   ReturnCode end;
  561.   struct Expr *val;
  562.   unsigned long *tag=tags;
  563.   uchar storeglobals;    /* DEFAULT: fplInit() value! */
  564.   struct Program *thisprog, *prog;
  565.   struct Store *store;
  566.   struct Local *glob;
  567.   long currcol;
  568.   long *globpointer=NULL;
  569.  
  570.   /* Store the 'soft' debugging information! */
  571.   long prev_mode = scr->flags & (FPLDATA_DEBUG_MODE|FPLDATA_ISOLATE);
  572.  
  573. #ifdef DEBUG
  574.   long memory=mem;
  575. #endif
  576.  
  577.   if(!scr)
  578.     /* misbehaviour */
  579.     return(FPLERR_ILLEGAL_ANCHOR);
  580.  
  581.   if(scr->runs) {
  582.     /* this is a nested call! */
  583.     GETMEM(store, sizeof(struct Store));
  584.  
  585.     currcol=scr->text-(&scr->prog->program)[scr->prg-1];
  586.  
  587.     LeaveProgram(scr, scr->prog);
  588.     memcpy(store, &scr->text, sizeof(struct Store));
  589.   } else {
  590.     scr->msg = NULL;  /* We start with an empty message queue! */
  591.     scr->varlevel =0; /* start at locale level 0 */
  592.   }
  593.   end = AddProgram(scr, &prog, program, lines, filename);
  594.  
  595.   if(NULL == prog && FPL_OK == end) {
  596.     /*
  597.      * This execution was simply prevented due to circumstances!
  598.      */
  599.   }
  600.   else if(end <= FPL_EXIT_OK) {
  601.  
  602.     if(!prog->program && filename) {
  603.       /*
  604.        * It didn't already exist.
  605.        */
  606.       if(scr->flags & (FPLDATA_AUTORUN|FPLDATA_AUTOCOMPILE))
  607.         FileCheck(scr, &filename, prog);
  608.       end = ReadFile(scr, filename, prog); /* get file */
  609.       prog->flags|=PR_NAME_IS_FILENAME;
  610.       SetupCompiled(prog);
  611.       if(prog->flags & PR_SELECTED_FPC) {
  612.         FREE(filename);
  613.       }
  614.     }
  615.     else if(!filename)
  616.       prog->flags=PR_USERSUPPLIED;
  617.  
  618.     if(end <= FPL_EXIT_OK) {
  619.  
  620.       end=GetProgram(scr, prog); /* lock it for our use! */
  621.  
  622.       if(end <= FPL_EXIT_OK) {
  623.  
  624.         thisprog=scr->prog;
  625.         if(scr->flags&FPLDATA_CACHEALLFILES) {
  626.           thisprog->flags|=PR_CACHEFILE;
  627.           if(scr->flags&FPLDATA_CACHEEXPORTS)
  628.             thisprog->flags|=PR_CACHEEXPORTS;
  629.         } else
  630.           thisprog->flags&=~PR_CACHEFILE;
  631.  
  632.         thisprog->openings++;
  633.  
  634.         scr->prg=thisprog->startprg;     /* starting line number */
  635.         scr->text=(&thisprog->program)[thisprog->startprg-1]+
  636.           thisprog->startcol; /* execute point */
  637.  
  638.  
  639.     /* fprintf(stderr, "Exp:%s", scr->text); */
  640.  
  641.         scr->ret=FPL_OK;        /* return code reset */
  642.         scr->virprg=thisprog->virprg;    /* starting at right virtual line */
  643.         scr->virfile=thisprog->virfile;    /* starting at right virtual file */
  644.         scr->level=0;            /* level counter */
  645.         scr->strret=FALSE;        /* we don't want no string back! */
  646.         scr->interpret=NULL;        /* no interpret tag as default */
  647.         scr->locals=NULL;        /* local symbol list */
  648.         scr->globals=NULL;        /* global symbol list */
  649.         scr->FPLret=0;            /* initialize return code value */
  650.         scr->string_return=NULL;    /* no string returns allowed */
  651.         scr->msg = NULL;                /* no pending messages */
  652.  
  653.         while(tag && *tag) {
  654.           switch(*tag++) {
  655.           case FPLTAG_ISOLATE:
  656.         scr->flags = BitToggle(scr->flags, FPLDATA_ISOLATE, *tags);
  657.         break;
  658.  
  659.           case FPLTAG_DEBUG:
  660.         scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE, *tags);
  661.         break;
  662.  
  663.           case FPLTAG_REREAD_CHANGES:
  664.         thisprog->flags = BitToggle(thisprog->flags,
  665.                     PR_REREAD_CHANGES, *tags);
  666.             break;
  667.  
  668.           case FPLTAG_FLUSH_NOT_IN_USE:
  669.         thisprog->flags = BitToggle(thisprog->flags,
  670.                     PR_FLUSH_NOT_IN_USE, *tags);
  671.             break;
  672.  
  673.           case FPLTAG_KIDNAP_CACHED:
  674.         thisprog->flags = BitToggle(thisprog->flags,
  675.                     PR_KIDNAP_CACHED, *tags);
  676.             break;
  677.  
  678.           case FPLTAG_STRING_RETURN:
  679.             scr->string_return = (uchar **)*tag;
  680.             scr->strret=TRUE; /* enable return string */
  681.             break;
  682.  
  683.           case FPLTAG_INTERPRET:
  684.             scr->interpret=(uchar *)*tag;
  685.             break;
  686.  
  687.           case FPLTAG_STARTPOINT:
  688.             scr->text=(uchar *)*tag;
  689.             break;
  690.           case FPLTAG_STARTLINE:
  691.             scr->prg=(long)*tag;
  692.             break;
  693.           case FPLTAG_USERDATA:
  694.             scr->userdata=(void *)*tag;
  695.             break;
  696.           case FPLTAG_CACHEFILE:
  697.             if(*tag) {
  698.               thisprog->flags|=PR_CACHEFILE;
  699.               if(*tag=FPLCACHE_EXPORTS)
  700.                 thisprog->flags|=PR_CACHEEXPORTS;
  701.             } else
  702.               thisprog->flags&=~PR_CACHEFILE;
  703.             break;
  704.           case FPLTAG_PROGNAME:
  705.         if(*tag) {
  706.               prog=scr->programs;
  707.               while(prog) {
  708.                 if(prog->name && !strcmp(prog->name, (uchar *)*tag))
  709.                   break;
  710.                 prog=prog->next;
  711.               }
  712.               if(!prog) {
  713.                 /*
  714.                  * The program was not found, then set/rename the
  715.                  * current program to this name!
  716.                  */
  717.                 if(thisprog->name) {
  718.                   FREEA(thisprog->name);
  719.                 }
  720.                 STRDUPA(thisprog->name, *tag);
  721.               } else {
  722.                 /*
  723.                  * We found another progam with that name. Execute that
  724.                  * instead of this!
  725.                  */
  726.                 DelProgram(scr, thisprog);
  727.                 thisprog=prog;
  728.               }
  729.         }
  730.             break;
  731.           case FPLTAG_FILENAMEGET:
  732.         thisprog->flags = BitToggle(thisprog->flags,
  733.                     PR_FILENAMEFLUSH, *tags);
  734.             break;
  735.           case FPLTAG_ISCACHED:
  736.             globpointer = (long *)*tag;
  737.             break;
  738.           }
  739.           tag++;
  740.         }
  741.  
  742.         if(!thisprog->name) {
  743.           /* If no name has been given, do not store any global symbols from it! */
  744.           STRDUPA(thisprog->name, FPLTEXT_UNKNOWN_PROGRAM);
  745.           storeglobals=FALSE;
  746.           thisprog->flags&=~(PR_CACHEFILE|PR_CACHEEXPORTS);
  747.         } else
  748.           storeglobals = thisprog->flags&(PR_CACHEFILE|PR_CACHEEXPORTS);
  749.  
  750.         scr->virfile=thisprog->name; /* starting with this file */
  751.         val= MALLOC(sizeof(struct Expr));
  752.         if(val) {
  753.           end=Go(scr, val);
  754.           if(end<=FPL_EXIT_OK &&
  755.              scr->string_return) {
  756.             /*
  757.              * No error and
  758.              * we accept string returns and...
  759.              */
  760.             if((val->flags&(FPL_STRING|FPL_RETURN)) ==
  761.                (FPL_STRING|FPL_RETURN) &&
  762.                val->val.str) {
  763.               /*
  764.                * ...there was a final "return" or "exit" keyword.
  765.                * and we have a returned string to deal with.
  766.                */
  767.   
  768.               /* assign the pointer */
  769.               *scr->string_return = val->val.str->string;
  770.   
  771.               /* make it a "static" allocation */
  772.               SwapMem(scr, val->val.str, MALLOC_STATIC);
  773.             }
  774.             else {
  775.               /*
  776.                * If not, reset the pointer to NULL!
  777.                */
  778.               *scr->string_return = NULL;
  779.             }
  780.           }
  781.           FREE(val);
  782.         } else
  783.           end=FPLERR_OUT_OF_MEMORY;
  784.  
  785.         if(end>FPL_EXIT_OK) {
  786.           struct fplArgument pass={
  787.             NULL, FPL_GENERAL_ERROR, NULL, 0};
  788.           void *array[1];
  789.           pass.key=(void *)scr;
  790.           array[0] = (void *)end;
  791.           pass.argv= array;
  792.  
  793.           thisprog = scr->prog;
  794.           
  795.           if(thisprog->flags&PR_COMPILED)
  796.             scr->buf[0]=0; /* no damned identifier */
  797.             
  798.           if(scr->error) {
  799.         /* We'll fix the error string! */
  800.         GetErrorMsg(scr, end, scr->error);
  801.       }
  802.  
  803.           /* new argv assigning for OS/2 compliance! */
  804.           InterfaceCallNoStack(scr, &pass, scr->function);
  805.         }
  806.  
  807.         thisprog->column=scr->text-(&thisprog->program)[scr->prg-1]+1;
  808.         scr->virfile=NULL; /* most likely to not point to anything decent
  809.                               anyway! */
  810.  
  811.         /*
  812.          * Go through the ENTIRE locals list and delete all. Otherwise they will
  813.          * ruin the symbol table.
  814.          */
  815.  
  816.         while(scr->locals)
  817.           DelLocalVar(scr, &scr->locals);
  818.  
  819.         thisprog->openings--;
  820.         LeaveProgram(scr, thisprog); /* failure is a victory anyway! */
  821.  
  822.         /*
  823.          * If the option to cache only programs exporting symbols is turned on,
  824.          * then we must check if any of the globals are exported before caching!
  825.          */
  826.  
  827.         if(end<=FPL_EXIT_OK && (storeglobals & PR_CACHEEXPORTS)) {
  828.           glob = scr->globals;
  829.  
  830.           while(glob) {
  831.             /* Traverse all global symbols */
  832.  
  833.             if(glob->ident->flags&FPL_EXPORT_SYMBOL)
  834.               /* if we found an exported symbol, get out of loop */
  835.               break;
  836.  
  837.             glob=glob->next; /* goto next global */
  838.           }
  839.  
  840.           if(!glob)
  841.             /* no exported symbols were found! */
  842.             storeglobals = FALSE; /* do not cache this file! */
  843.         }
  844.  
  845.         if(end<=FPL_EXIT_OK && storeglobals && thisprog->flags&PR_CACHEFILE) {
  846.          /* no error, store the globals and cache the file */
  847.  
  848.           if(!(thisprog->flags&PR_GLOBALSTORED)) {
  849.  
  850.             if(scr->globals) {
  851.           long total_size;
  852.           long line=1;
  853.           uchar *newprogram;
  854.               {
  855.         if(!(thisprog->flags&PR_USERSUPPLIED))
  856.           /*
  857.            * The memory is allocated by FPL itself!
  858.            */
  859.                   SwapMem(scr, thisprog->program, MALLOC_STATIC);
  860.         else {
  861.                   /*
  862.                    * The memory is allocated by the user!
  863.            */
  864.           if(thisprog->flags&PR_KIDNAP_CACHED) {
  865.             /*
  866.              * We have been instructed to "take over" all host
  867.              * allocations that we intend to keep as cached files!
  868.              */
  869.  
  870.             /* start with counting the total size of the program: */
  871.             for(line = total_size = 0; line<thisprog->lines; line++)
  872.               total_size += strlen( (&thisprog->program)[line] );
  873.  
  874.             /* get enough memory to duplicate it! */
  875.             newprogram = MALLOCA(total_size + 1 ); /* add for zero */
  876.                     newprogram[total_size] = CHAR_ASCII_ZERO;
  877.             if(newprogram) {
  878.               /*
  879.                * We got requested amount of memory to copy the entire
  880.                * user supplied program!
  881.                */
  882.                       for(line = total_size = 0; line<thisprog->lines; line++) {
  883.                         strcpy(newprogram+total_size,
  884.                    (&thisprog->program)[line]);
  885.             total_size += strlen( (&thisprog->program)[line] );
  886.               }
  887.               thisprog->program = newprogram;
  888.               thisprog->lines = 1; /* this is now in one single line! */
  889.  
  890.                       /* switch off the now incorrect bit: */
  891.               thisprog->flags &= ~PR_USERSUPPLIED;
  892.             }
  893.             else {
  894.               /* We couldn't allocate a copy of the program, fail */
  895.               line=0;
  896.               end = FPLERR_OUT_OF_MEMORY; /* fail with proper return
  897.                                              code! */
  898.             }
  899.           }
  900.         }
  901.           }
  902.           if(line) {
  903.                 /* Store all global symbols!!! */
  904.                 StoreGlobals(scr, MALLOC_STATIC); /* ignore return code */
  905.  
  906.             /* set the flag saying we did so! */
  907.                 thisprog->flags|=PR_GLOBALSTORED;
  908.           }
  909.             } else
  910.               DelProgram(scr, thisprog); /* this also removes the Lock() */
  911.           }
  912.         } else {
  913.           /*
  914.            * We must delete the global symbol lists
  915.            * properly and not just free the memory. Otherwise we might free memory
  916.            * used in the middle of the list we intend to save for next run!
  917.            */
  918.           if(!thisprog->openings) {
  919.             /* If not in use */
  920.             if(scr->globals)
  921.             /* There is some global symbols to delete! */
  922.             DelLocalVar(scr, &scr->globals);
  923.  
  924.             /*
  925.              * Check if this program was stored in memory earlier (in
  926.              * another run). If not ...
  927.              */
  928.             if(!(thisprog->flags&PR_GLOBALSTORED)) {
  929.               /*
  930.                * ...delete this program from memory!
  931.                */
  932.               DelProgram(scr, thisprog); /* this also removes the Lock() */
  933.             }
  934.           }
  935.         }
  936.  
  937.         if(globpointer)
  938.           *globpointer=(long)scr->globals;
  939.  
  940.         scr->runs--;
  941.       } /* else
  942.           We didn't get the program, out of memory or stupid interface
  943.           function reply!
  944.          */
  945.     } else
  946.       DelProgram(scr, prog); /* we couldn't load it! */
  947.   }
  948.  
  949.   /*
  950.    * Reset the debug mode status we had when we entered this function!
  951.    */
  952.   scr->flags = BitToggle(scr->flags, FPLDATA_DEBUG_MODE,
  953.                          prev_mode&FPLDATA_DEBUG_MODE);
  954.   /*
  955.    * Reset the isolate status we had when we entered this function!
  956.    */
  957.   scr->flags = BitToggle(scr->flags, FPLDATA_ISOLATE,
  958.                          prev_mode&FPLDATA_ISOLATE);
  959.  
  960.   if(scr->runs) {
  961.     /* still running! */
  962.  
  963.     memcpy(&scr->text, store, sizeof(struct Store));
  964.     GetProgram(scr, scr->prog);
  965.     FREE(store);
  966.  
  967.     /* reset execute point: */
  968.     scr->text=(&scr->prog->program)[scr->prg-1]+ currcol;
  969.   }
  970.   else {
  971.     FREEALL(); /* frees all ALLOC_DYNAMIC */
  972.   }
  973.  
  974.   return(end==FPL_EXIT_OK?FPL_OK:end);
  975. }
  976.  
  977. /**********************************************************************
  978.  *
  979.  * Go();
  980.  *
  981.  * This is an own function to make the stack usage in this particular
  982.  * function very small. Then we don't have to copy more than 10-20 bytes
  983.  * of the old stack when swapping to the new in the amiga version of the
  984.  * library!
  985.  *
  986.  ******/
  987.  
  988. static ReturnCode Go(struct Data *scr, struct Expr *val)
  989. {
  990. #if defined(AMIGA) && defined(SHARED)
  991.   /* The function call below is an assembler routine that allocates a new
  992.      stack to use in the library! */
  993. #define FIRSTFUNC InitStack
  994. #else
  995.   /* Not Amiga or not shared! */
  996. #define FIRSTFUNC Script
  997. #endif
  998.  
  999.   scr->runs++;
  1000.   return FIRSTFUNC(scr, val,
  1001.                    SCR_BRACE|    /* to make it loop and enable declarations */
  1002.                    SCR_FUNCTION| /* return on return() */
  1003.                    SCR_FILE|     /* this level may end with '\0' */
  1004.                    SCR_GLOBAL,   /* global symbol declarations enabled */
  1005.                    NULL);
  1006. }
  1007.  
  1008.  
  1009. static ReturnCode REGARGS
  1010. StoreGlobals(struct Data *scr,
  1011.              uchar type)
  1012. {
  1013.   struct Local *local, *prev=NULL;
  1014.   struct Identifier *ident;
  1015.   struct fplVariable *var;
  1016.  
  1017.   if(scr->prog->running>1)
  1018.     /*
  1019.      * It's enough if we commit this only on the ground level exit!
  1020.      */
  1021.     return(FPL_OK);
  1022.  
  1023.   local=scr->globals;
  1024.   while(local) {
  1025.     ident=local->ident;
  1026.     if(ident->flags&FPL_VARIABLE) {
  1027.       SwapMem(scr, local, type);        /* preserve the chain! */
  1028.       SwapMem(scr, ident, type);        /* structure */
  1029.  
  1030.       if(!(ident->flags&FPL_COMPILER_ADDED))
  1031.         SwapMem(scr, ident->name, type);    /* name */
  1032.  
  1033.       var=&ident->data.variable;
  1034.  
  1035.       SwapMem(scr, var->var.val32, type); /* variable area */
  1036.  
  1037.       if(!var->num && ident->flags&FPL_STRING_VARIABLE && var->var.str[0])
  1038.     /* no array but assigned string variable */
  1039.     SwapMem(scr, var->var.str[0], type);    /* string */
  1040.       else if(var->num) {
  1041.     /* array */
  1042.     SwapMem(scr, var->dims, type); /* dim info */
  1043.     if(ident->flags&FPL_STRING_VARIABLE) {
  1044.       int i;
  1045.       for(i=0; i<var->size; i++) {
  1046.         /* Take one pointer at a time */
  1047.         if(var->var.str[i])
  1048.           /* if the value is non-zero, it contains the allocated length
  1049.          of the corresponding char pointer in the ->array->vars
  1050.          array! */
  1051.           SwapMem(scr, var->var.str[i], type);
  1052.           }
  1053.       SwapMem(scr, var->var.str, type);
  1054.     }
  1055.       }
  1056.     } else if(ident->flags&FPL_FUNCTION) {
  1057.       SwapMem(scr, local, type);        /* preserve the chain! */
  1058.       SwapMem(scr, ident, type);        /* structure */
  1059.       if(!(ident->flags&FPL_COMPILER_ADDED)) {
  1060.         SwapMem(scr, ident->name, type);        /* name */
  1061.         SwapMem(scr, ident->data.inside.format, type);    /* parameter string */
  1062.       }
  1063.     }
  1064.     prev=local;
  1065.     local=local->next;
  1066.   }
  1067.   if(prev) {
  1068.     prev->next=scr->usersym; /* link in front of our previous list! */
  1069.     scr->usersym=scr->globals;
  1070.   }
  1071.   scr->globals=NULL;
  1072.   return(FPL_OK);
  1073. }
  1074.  
  1075. /**************************************************************************
  1076.  *
  1077.  * int Script(struct Data *);
  1078.  *
  1079.  * Interprets an FPL program, very recursive. Returns progress in an integer,
  1080.  * and the FPL program result code in the int scr->ret.
  1081.  * USE AS FEW VARIABLES AS POSSIBLE to spare stack usage!
  1082.  *
  1083.  **********/
  1084.  
  1085. ReturnCode ASM
  1086. Script(AREG(2) struct Data *scr,  /* big FPL structure */
  1087.        AREG(3) struct Expr *val,  /* result structure  */
  1088.        DREG(2) short control,     /* control byte */
  1089.        AREG(1) struct Condition *con)
  1090. {
  1091.   uchar declare=control&SCR_BRACE?1:0; /* declaration allowed? */
  1092.   ReturnCode ret;           /* return value variable */
  1093.   struct Condition *con2;      /* recursive check information! */
  1094.   uchar brace=0; /* general TRUE/FALSE variable */
  1095.   uchar *text; /* position storage variable */
  1096.   long prg;   /* position storage variable */
  1097.   long levels=scr->level; /* previous level spectra */
  1098.   struct Identifier *ident; /* used when checking keywords */
  1099.   long virprg=scr->virprg;
  1100.   uchar *virfile=scr->virfile;
  1101.   uchar done=FALSE; /* TRUE when exiting */
  1102.   struct fplArgument *pass;
  1103.  
  1104. #if defined(AMIGA) && defined(SHARED)
  1105.   if(ret=CheckStack(scr, scr->stack_limit, scr->stack_margin)) {
  1106.     if(ret==1)
  1107.       return(FPLERR_OUT_OF_MEMORY);
  1108.     else
  1109.       return(FPLERR_OUT_OF_STACK);
  1110.   }
  1111. #endif
  1112.  
  1113.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  1114.     /*
  1115.      * New symbol declaration level!
  1116.      */
  1117.     scr->varlevel++;
  1118.     CALL(AddLevel(scr));
  1119.   }
  1120.  
  1121.   if(control&SCR_FUNCTION)
  1122.     scr->level=0; /* number of levels to look for variables */
  1123.   else if(control&SCR_BRACE)
  1124.     scr->level++;
  1125.  
  1126.   if(scr->flags&FPLDATA_DEBUG_MODE) {
  1127.     /*
  1128.      * If debug mode is on already here, it means that our previous level
  1129.      * had it and we must make sure that they will even when we return.
  1130.      * (Without that bit, CleanUp() will switch off debug mode!)
  1131.      */
  1132.     control|=SCR_DEBUG;
  1133.   }
  1134.  
  1135.   if(scr->prog->flags&PR_COMPILED) {
  1136.     /*
  1137.      * Halleluja! This is a compiled mega-mighty-cool FPL program designed
  1138.      * for maximum interpreting speed.
  1139.      */
  1140.      
  1141.     /* THE FOLLOWING LINE IS TEMPORARY ADDED HERE: */
  1142.     scr->globalinfo = &scr->prog->globalinfo;
  1143.      
  1144.     brace = FALSE; /* set to false from start, set it back after usage!    */
  1145.     
  1146.     while(!done) {
  1147.       Pass2 code; /* compiled instruction */
  1148.  
  1149.       if(scr->interfunc) {
  1150.         /* call the interval function */
  1151.         if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
  1152.         return FPLERR_PROGRAM_STOPPED;
  1153.       }
  1154.       code = GETSHORT;
  1155.  
  1156.       P_SHORT; /* pass the instruction */
  1157.  
  1158.       switch(code) {
  1159.         /* These codes are defined in pass2.h */
  1160.         case PASS2_LINE_NUMBER:
  1161.           scr->virprg = GETLONG;
  1162.           P_LONG;
  1163.           break;
  1164.           
  1165.         case PASS2_BREAK_EXPR:
  1166.           CALL(CmpBreak(scr, val));
  1167.           break;
  1168.           
  1169.         case PASS2_SWITCH:
  1170.           CALL(CmpSwitch(scr, val));
  1171.           break;
  1172.           
  1173.         case PASS2_END_OF_EXPR:
  1174.           break;
  1175.  
  1176.         case PASS2_DECLARE:
  1177.           CALL(CmpDeclare(scr));
  1178.           break;
  1179.  
  1180.         case PASS2_EXPORT_FUNCTION:
  1181.           CALL(CmpExport(scr));
  1182.           break;
  1183.  
  1184.         case PASS2_ASSIGN_ARGUMENT: /* [var number] [argument number] */
  1185.           CALL(AssignArg(scr));
  1186.           break;
  1187.           
  1188.         case PASS2_LABEL_GOTO: /* OFFSET to set the program pointer to */
  1189.           scr->text = &scr->prog->program[ scr->prog->index + GETLONG ];
  1190.           break;
  1191.  
  1192.         case PASS2_IFNOT_BRANCH:       /* OFFSET follows */
  1193.           brace = TRUE;
  1194.           /* falls through! */
  1195.         case PASS2_IF_BRANCH:  /* OFFSET follows */
  1196.           prg = GETLONG;
  1197.           P_LONG; /* pass offset */
  1198.           CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM)); /* get result */
  1199.           
  1200.           if(brace ^ (val->val.val?TRUE:FALSE))
  1201.             scr->text = &scr->prog->program[ scr->prog->index + prg ];
  1202.           else
  1203.             P_SHORT; /* pass end of expr */
  1204.           brace = FALSE; /* it has served its purpose, set back to FALSE */
  1205.           break;
  1206.       
  1207.         case PASS2_MAIN_START: /* OFFSET the main program starts at */
  1208.           scr->prog->startcol=
  1209.             scr->prog->index + GETLONG;
  1210.           P_LONG; /* pass the argument */
  1211.           scr->prog->foundstart=TRUE;
  1212.           break;
  1213.           
  1214.         case PASS2_RETURN:
  1215.         case PASS2_EXIT:
  1216.           if(scr->strret) {
  1217.             /*
  1218.              * This function is supposed to return a string. Get it.
  1219.              */
  1220.             CALL(CmpExpr(val, scr, CON_STRING));
  1221.  
  1222.             if(val->flags&FPL_NOFREE) {
  1223.               /*
  1224.                * We're only refering to another string! We can't
  1225.                * allow that since that string might be a local
  1226.                * variable, and all such are about to be deleted now!
  1227.                */
  1228.               register struct fplStr *string;
  1229.               if(val->val.str) {
  1230.                 /* did we really get a pointer? */
  1231.                 GETMEM(string, val->val.str->len+sizeof(struct fplStr));
  1232.                 memcpy(string,
  1233.                 val->val.str,
  1234.                 val->val.str->len+sizeof(struct fplStr));
  1235.                 string->alloc=val->val.str->len;
  1236.                 strtags[1]=(long)string->string;
  1237.                 strtags[3]=string->len;
  1238.                 CALL(Send(scr, strtags));
  1239.               }
  1240.               else {
  1241.                 strtags[1]=0;
  1242.                 strtags[3]=0;
  1243.                 CALL(Send(scr, strtags));
  1244.               }
  1245.             }
  1246.             else {
  1247.               strtags[1]=(long)val->val.str->string;
  1248.               strtags[3]=val->val.str->len;
  1249.               CALL(Send(scr, strtags));
  1250.             }
  1251.           }
  1252.           else {
  1253.             CALL(CmpExpr(val, scr, CON_GROUNDLVL|CON_NUM));
  1254.         scr->FPLret=val->val.val;    /* set return code! */
  1255.             scr->returnint = &scr->FPLret; /* point to result */
  1256.             inttags[1]=val->val.val;
  1257.             CALL(Send(scr, inttags));
  1258.       }
  1259.           done = TRUE;
  1260.           if(PASS2_EXIT == code)
  1261.             ret = FPL_EXIT_OK; /* exit from this file */
  1262.           break;
  1263.  
  1264.         case PASS2_RESET_VARIABLE:
  1265.           CALL(CmpReset(scr, GETLONG)); /* reset the local variable to
  1266.                                            "scratch position" */
  1267.           P_LONG;
  1268.           break;
  1269.           
  1270.         default:
  1271.           scr->text-=sizeof(short); /* back on the instruction */
  1272.           CALL(CmpExpr(val, scr, CON_NORETURN|CON_GROUNDLVL));
  1273.           break;
  1274.       }
  1275.     }
  1276.     if(scr->localinfo.listsize) {
  1277.       FREE(scr->localinfo.list);
  1278.       scr->localinfo.listentries = scr->localinfo.listsize =0;
  1279.     }
  1280.   }
  1281.   else {
  1282.   
  1283.     while(!done) {
  1284.       if(ret=Eat(scr)) {
  1285.         if(control&SCR_FILE && ret==FPLERR_UNEXPECTED_END)
  1286.           /* It's OK! */
  1287.           ret=FPL_OK;
  1288.         break;
  1289.       }
  1290.   
  1291.       /* call the interval function */
  1292.       if(scr->interfunc) {
  1293.         if(scr->data=InterfaceCall(scr, scr->userdata, scr->interfunc))
  1294.           return FPLERR_PROGRAM_STOPPED;
  1295.       }
  1296.   
  1297.   #ifdef DEBUGMAIL
  1298.       DebugMail(scr, MAIL_EXECUTE, 500, NULL);
  1299.   #endif
  1300.   
  1301.       switch(*scr->text) {
  1302.       case CHAR_OPEN_BRACE:               /* open brace */
  1303.         scr->text++;
  1304.         CALL(Script(scr, val,
  1305.                     SCR_NORMAL|SCR_BRACE,
  1306.                     con));
  1307.         if(CheckIt(scr, val, control, &ret)) {
  1308.           CleanUp(scr, control, levels);
  1309.           return(ret);
  1310.         }
  1311.         break;
  1312.   
  1313.       case CHAR_CLOSE_BRACE:
  1314.         if(control&SCR_LOOP) {
  1315.           if(control&SCR_BRACE) {
  1316.             DelLocalVar(scr, &scr->locals); /* delete all local declarations */
  1317.             scr->varlevel--;                /* previous variable level */
  1318.             scr->level--;                   /* previous level spectra */
  1319.           }
  1320.           CALL(Loop(scr, con, control, &brace));
  1321.           if(brace) {
  1322.             /* Yes! We should loop! */
  1323.             if(control&SCR_BRACE) {
  1324.               /* bring back the proper values */
  1325.               scr->varlevel++;
  1326.               scr->level++;
  1327.               AddLevel(scr); /* restart this level! */
  1328.               declare=TRUE;
  1329.             }
  1330.             scr->virprg=virprg;
  1331.             scr->virfile=virfile;
  1332.             continue;
  1333.           }
  1334.           val->flags=0;
  1335.         } else {
  1336.           scr->text++;
  1337.           val->flags=FPL_BRACE;
  1338.           CleanUp(scr, control, levels);
  1339.         }
  1340.         scr->returnint = NULL; /* no result integer! */
  1341.         return(FPL_OK);  /* return to calling function */
  1342.   
  1343.       case CHAR_SEMICOLON:
  1344.         scr->text++;
  1345.         break;
  1346.   
  1347.       default:
  1348.         /*
  1349.          * Time to parse the statement!
  1350.          */
  1351.   
  1352.         text=scr->text;                /* store current position */
  1353.         prg=scr->prg;
  1354.         if(!Getword(scr))    /* get next word */
  1355.           GetIdentifier(scr, scr->buf, &ident);
  1356.         else {
  1357.           prg=-1;    /* we have not read a word! */
  1358.           ident=NULL;
  1359.         }
  1360.         if(ident && control&SCR_GLOBAL && declare) {
  1361.           /* still on ground level and declaration allowed */
  1362.           if(!(ident->flags&FPL_KEYWORD_DECLARE)) {
  1363.             if(!scr->prog->foundstart) {
  1364.               /*
  1365.                * Only do this if this point isn't already known!
  1366.                * We move the pointer for the execution start position to
  1367.                * this position.
  1368.                */
  1369.               StoreBeginning(scr, text, prg);
  1370.             }
  1371.             /*
  1372.              * This is the end of the declaration phase. Now, let's
  1373.              * check for that FPLTAG_INTERPRET tag to see if we should
  1374.              * have a little fun or simply continue!
  1375.              */
  1376.             if(scr->interpret) {
  1377.               done = TRUE;
  1378.               continue;
  1379.             }
  1380.           }
  1381.         }
  1382.         if(ident && ident->flags&FPL_KEYWORD) {
  1383.           if(ident->flags&FPL_KEYWORD_DECLARE) {
  1384.             if(!declare)
  1385.               return FPLERR_ILLEGAL_DECLARE;
  1386.             CALL(Declare(val, scr, ident, control&SCR_GLOBAL?CON_DECLGLOB:0));
  1387.   
  1388.           } else {
  1389.             switch(ident->data.external.ID) {
  1390.             case CMD_SWITCH:
  1391.               scr->breaks++; /* allow another level of break */
  1392.               CALL(Switch(scr, val, control, con));
  1393.               if(CheckIt(scr, val, control, &ret)) {
  1394.                 CleanUp(scr, control, levels);
  1395.                 return(ret);
  1396.               }
  1397.               break;
  1398.   
  1399.             case CMD_CASE:    /* 'case' */
  1400.               if(!control&SCR_SWITCH)
  1401.                 return FPLERR_ILLEGAL_CASE; /* 'case' not within switch! */
  1402.               /*
  1403.                * This word can only be found if (control&SCR_SWITCH), and then
  1404.                * we must just skip the "case XX:" text and continue.
  1405.                */
  1406.               CALL(Eat(scr));
  1407.               if(scr->text[0]==CHAR_OPEN_PAREN) {
  1408.                 /*
  1409.                  * If this is an open parenthesis, we must search for the
  1410.                  * opposite parenthesis to enable conditional statements
  1411.                  * using the '?' and ':' operators.
  1412.                  */
  1413.                 CALL(GetEnd(scr, CHAR_CLOSE_PAREN,
  1414.                             CHAR_OPEN_PAREN, FALSE)); /* find close paren! */
  1415.               }
  1416.               if(GetEnd(scr, CHAR_COLON, 255, FALSE)) /* find colon! */
  1417.                 return FPLERR_MISSING_COLON;
  1418.               if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str)
  1419.               /* If there was a string return, it should be freed and the
  1420.                  string really held a string! */
  1421.                 FREE(val->val.str);
  1422.               break;
  1423.   
  1424.             case CMD_DEFAULT: /* 'default' */
  1425.               if(!control&SCR_SWITCH)
  1426.                 return FPLERR_ILLEGAL_DEFAULT; /* 'default' not within switch! */
  1427.               /*
  1428.                * This word can only be found if (control&SCR_SWITCH), and then
  1429.                * we must just skip the "default:" text and continue.
  1430.                */
  1431.               if(scr->text[0]!=CHAR_COLON) {
  1432.                 if(GetEnd(scr, CHAR_COLON, 255, FALSE))
  1433.                   return FPLERR_MISSING_COLON;
  1434.               } else
  1435.                 scr->text++;
  1436.               break;
  1437.   
  1438.             case CMD_TYPEDEF:
  1439.               CALL(Getword(scr));
  1440.               CALL(GetIdentifier(scr, scr->buf, &ident));
  1441.               if(!ret &&
  1442.                  (ident->data.external.ID==CMD_INT ||
  1443.                   ident->data.external.ID==CMD_STRING)) {
  1444.                 CALL(Getword(scr));
  1445.                 text=(void *)ident;
  1446.                 GETMEM(ident, sizeof(struct Identifier));
  1447.                 *ident=*(struct Identifier *)text; /* copy entire structure! */
  1448.                 GETMEM(ident->name, strlen(scr->buf)+1);
  1449.                 strcpy(ident->name, scr->buf);
  1450.                 ident->flags&=~FPL_INTERNAL_FUNCTION; /* no longer any internal
  1451.                                                          declarator symbol! */
  1452.                 CALL(AddVar(scr, ident, &scr->locals));
  1453.               } else
  1454.                 return FPLERR_IDENTIFIER_NOT_FOUND;
  1455.               break;
  1456.             case CMD_RETURN:
  1457.             case CMD_EXIT:
  1458.               Eat(scr);
  1459.               scr->breaks=0; /* reset number of allowed breaks */
  1460.               scr->returnint = NULL; /* point to result */
  1461.               if(*scr->text!=CHAR_SEMICOLON) { /* no return */
  1462.                 brace=*scr->text==CHAR_OPEN_PAREN; /* not required! */
  1463.                 scr->text+=brace;
  1464.   
  1465.                 /*
  1466.                  * If return()ing from a function when scr->strret is TRUE,
  1467.                  * return a string.
  1468.                  */
  1469.                 if((scr->strret && ident->data.external.ID==CMD_RETURN) ||
  1470.                    (scr->string_return && ident->data.external.ID==CMD_EXIT)) {
  1471.                   CALL(Expression(val, scr, CON_NORMAL, NULL));
  1472.                   if(!(val->flags&FPL_STRING)) {
  1473.                     /* that wasn't a string! */
  1474.                     return FPLERR_UNEXPECTED_INT_STATEMENT;
  1475.                   } else {
  1476.                     /* It was a string! */
  1477.                     if(val->flags&FPL_NOFREE) {
  1478.                       /*
  1479.                        * We're only refering to another string! We can't
  1480.                        * allow that since that string might be a local
  1481.                        * variable, and all such are about to be deleted now!
  1482.                        */
  1483.                       struct fplStr *string;
  1484.                       if(val->val.str) {
  1485.                         /* did we really get a pointer? */
  1486.                         GETMEM(string, val->val.str->len+sizeof(struct fplStr));
  1487.                         memcpy(string, 
  1488.                                val->val.str,
  1489.                                val->val.str->len+sizeof(struct fplStr));
  1490.                         string->alloc=val->val.str->len;
  1491.                       }
  1492.                       else {
  1493.                         GETMEM(string, sizeof(struct fplStr));
  1494.                         string->len = string->alloc = 0;
  1495.                       }
  1496.                       strtags[1]=(long)string->string;
  1497.                       strtags[3]=string->len;
  1498.                       CALL(Send(scr, strtags));
  1499.   
  1500.                       val->val.str=string;
  1501.                       val->flags&=~FPL_NOFREE;
  1502.                     }
  1503.                     else {
  1504.                       strtags[1]=(long)val->val.str->string;
  1505.                       strtags[3]=val->val.str->len;
  1506.                       CALL(Send(scr, strtags));
  1507.                     }
  1508.                   }
  1509.   
  1510.                 } else {
  1511.                   CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1512.                   scr->returnint = &scr->FPLret; /* point to result */
  1513.                   inttags[1]=val->val.val;
  1514.                   CALL(Send(scr, inttags));
  1515.                 }
  1516.                 if(brace)
  1517.                   if(*scr->text!=CHAR_CLOSE_PAREN)
  1518.                     return FPLERR_MISSING_PARENTHESES;
  1519.                     /* continue */
  1520.                   else
  1521.                     scr->text++;
  1522.               } else {
  1523.                 val->val.val=0;
  1524.                 val->flags=0;
  1525.               }
  1526.               scr->FPLret=val->val.val;   /* set return code! */
  1527.               if(ident->data.external.ID==CMD_RETURN) {
  1528.                 ret=FPL_OK;
  1529.               } else
  1530.                 ret=FPL_EXIT_OK; /* This will make us return through it all! */
  1531.   
  1532.               val->flags|=FPL_RETURN; /* inform calling function */
  1533.   
  1534.               CleanUp(scr, control, levels);
  1535.               return(ret);
  1536.             case CMD_IF:          /* if() */
  1537.             case CMD_WHILE:       /* while() */
  1538.               Eat(scr);
  1539.   
  1540.               /*********************
  1541.   
  1542.                 PARSE CONDITION
  1543.   
  1544.                 *******************/
  1545.   
  1546.   
  1547.               if(*scr->text!=CHAR_OPEN_PAREN)
  1548.                 return FPLERR_MISSING_PARENTHESES;
  1549.                 /* please, go on! */
  1550.               else
  1551.                 scr->text++;
  1552.   
  1553.               GETMEM(con2, sizeof(struct Condition));
  1554.   
  1555.               /* save check position! */
  1556.               con2->check=scr->text;
  1557.               con2->checkl=scr->prg;
  1558.   
  1559.               CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1560.               if(*scr->text!=CHAR_CLOSE_PAREN) {
  1561.                 return FPLERR_MISSING_PARENTHESES;
  1562.                 /* continue */
  1563.               } else
  1564.                 scr->text++;
  1565.   
  1566.               if(val->val.val) {
  1567.                 /********************
  1568.   
  1569.                   PARSE STATMENT
  1570.   
  1571.                   ******************/
  1572.   
  1573.                 Eat(scr);
  1574.                 scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1575.                 con2->bracetext=scr->text;
  1576.                 con2->braceprg=scr->prg;
  1577.   
  1578.                 if(CMD_WHILE == ident->data.external.ID)
  1579.                   scr->breaks++; /* yet another break level */
  1580.                 CALL(Script(scr, val,
  1581.                             (brace?SCR_BRACE:0)|
  1582.                             (ident->data.external.ID==CMD_WHILE?SCR_WHILE:SCR_IF),
  1583.                             con2));
  1584.                 if(CheckIt(scr, val, control, &ret)) {
  1585.                   FREE(con2);
  1586.                   CleanUp(scr, control, levels);
  1587.                   return(ret);
  1588.                 }
  1589.                 brace=TRUE;
  1590.               } else {
  1591.                 /********************
  1592.   
  1593.                   SKIP STATEMENT
  1594.   
  1595.                   ******************/
  1596.   
  1597.                 CALL(SkipStatement(scr));
  1598.                 brace=FALSE;
  1599.               }
  1600.   
  1601.               Eat(scr); /* we must eat space before storing the position,
  1602.                            otherwise we might eat newlines several times! */
  1603.               
  1604.               text=scr->text;
  1605.               prg=scr->prg;
  1606.   
  1607.               Getword(scr);
  1608.   
  1609.               if(!strcmp(KEYWORD_ELSE, scr->buf) && brace) {
  1610.                 /********************
  1611.   
  1612.                   SKIP STATEMENT
  1613.   
  1614.                   ******************/
  1615.   
  1616.                 CALL(SkipStatement(scr));
  1617.               } else if(!strcmp(KEYWORD_ELSE, scr->buf) && !brace) {
  1618.                 /********************
  1619.   
  1620.                   PARSE STATMENT
  1621.   
  1622.                   ******************/
  1623.   
  1624.                 Eat(scr);
  1625.                 scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1626.                 con2->bracetext=scr->text;
  1627.                 con2->braceprg=scr->prg;
  1628.                 CALL(Script(scr, val, (brace?SCR_BRACE:0), con2));
  1629.                 if(CheckIt(scr, val, control, &ret)) {
  1630.                   FREE(con2);
  1631.                   CleanUp(scr, control, levels);
  1632.                   return(ret);
  1633.                 }
  1634.               } else {
  1635.                 scr->text=text;
  1636.                 scr->prg=prg;
  1637.               }
  1638.               FREE(con2);
  1639.               break;
  1640.             case CMD_BREAK:
  1641.               val->val.val=1;     /* default is break 1 */
  1642.               val->flags=0;       /* reset flags */
  1643.               CALL(Eat(scr));
  1644.               /*
  1645.                * Check if break out of several statements.
  1646.                */
  1647.               if(*scr->text!=CHAR_SEMICOLON) {
  1648.                 /* Get the result of the expression. */
  1649.                 brace=*scr->text==CHAR_OPEN_PAREN;
  1650.                 scr->text+=brace;
  1651.                 CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  1652.                 if(brace)
  1653.                   if(*scr->text!=CHAR_CLOSE_PAREN) {
  1654.                     return FPLERR_MISSING_PARENTHESES;
  1655.                   } else
  1656.                     scr->text++;
  1657.                 else if(val->val.val<=0) {
  1658.                   return FPLERR_ILLEGAL_BREAK;
  1659.                 }
  1660.               }
  1661.               /*
  1662.                * Check that the requested number of break levels is possible
  1663.                * to break out from!
  1664.                */
  1665.               if(scr->breaks < val->val.val)
  1666.                 return FPLERR_ILLEGAL_BREAK;
  1667.   
  1668.               /*
  1669.                * Go to end of statement!!! If this was started without
  1670.                * SCR_BRACE set, we're already at the end of the statement!
  1671.                */
  1672.               if(control&SCR_BRACE) {
  1673.                 if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1674.                   return FPLERR_MISSING_BRACE;
  1675.   #ifdef DEBUG_BREAKS
  1676.                 fprintf(stderr, "First: levels %d line %d, brace? %d bl: %d\n",
  1677.                         val->val.val, scr->virprg, control&SCR_BRACE?1:0,
  1678.                         scr->breaks);
  1679.   #endif
  1680.               }
  1681.               if(control&SCR_DO)
  1682.                 /* if it was inside a do statement, pass the ending `while' */
  1683.                 CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  1684.               val->flags|=FPL_BREAK;
  1685.               if(control&(SCR_LOOP)) {
  1686.                 scr->breaks--; /* decrease break level counter */
  1687.                 if(!--val->val.val)
  1688.                   val->flags&=~FPL_BREAK; /* only this break! */
  1689.               }
  1690.               CleanUp(scr, control, levels);
  1691.               return(FPL_OK);
  1692.             case CMD_CONTINUE:
  1693.               if(*scr->text!=CHAR_SEMICOLON) {
  1694.                 return FPLERR_MISSING_SEMICOLON;
  1695.               } else
  1696.                 scr->text++;
  1697.               if(! scr->breaks)
  1698.                 return FPLERR_ILLEGAL_CONTINUE;
  1699.               if(control&SCR_LOOP) {
  1700.   
  1701.                 if(control&SCR_BRACE) {
  1702.                   DelLocalVar(scr, &scr->locals); /* delete all locals */
  1703.                   scr->varlevel--;                /* previous variable level */
  1704.                   scr->level--;                   /* previous level spectra */
  1705.                 }
  1706.   
  1707.                 /* loop! */
  1708.                 CALL(Loop(scr, con, control, &brace));
  1709.                 if(!brace) {
  1710.                   /*
  1711.                    * The result of the condition check was FALSE. Move to the end
  1712.                    * of the block and continue execution there!
  1713.                    */
  1714.   
  1715.                   if(control&SCR_BRACE) {
  1716.                     /* braces */
  1717.                     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1718.                       return FPLERR_MISSING_BRACE;
  1719.                   }
  1720.                   val->flags=0;
  1721.                 } else {
  1722.                   if(control&SCR_BRACE) {
  1723.                     /* bring back the proper values */
  1724.                     scr->varlevel++;
  1725.                     scr->level++;
  1726.                     AddLevel(scr); /* restart this level! */
  1727.                     declare=TRUE;
  1728.                   }
  1729.                   scr->virprg=virprg;
  1730.                   scr->virfile=virfile;
  1731.                   continue;
  1732.                 }
  1733.               } else {
  1734.                 /* it's no looping statement! */
  1735.   
  1736.                 if(control&SCR_BRACE) {
  1737.                   /* braces */
  1738.                   if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  1739.                     return FPLERR_MISSING_BRACE;
  1740.                 }
  1741.                 val->flags=FPL_CONTINUE;
  1742.                 CleanUp(scr, control, levels);
  1743.               }
  1744.               return(FPL_OK);
  1745.             case CMD_DO:
  1746.               CALL(Eat(scr));
  1747.               GETMEM(con2, sizeof(struct Condition));
  1748.               scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1749.               con2->bracetext=scr->text;
  1750.               con2->braceprg=scr->prg;
  1751.               con2->check=NULL;
  1752.               scr->breaks++; /* increase break level */
  1753.               CALL(Script(scr, val, SCR_DO|(brace?SCR_BRACE:0), con2));
  1754.               FREE(con2);
  1755.               if(CheckIt(scr, val, control, &ret)) {
  1756.                 CleanUp(scr, control, levels);
  1757.                 return(ret);
  1758.               }
  1759.               break;
  1760.             case CMD_FOR:
  1761.               Eat(scr);
  1762.               scr->text++;
  1763.               CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON, NULL));
  1764.   
  1765.               if(*scr->text!=CHAR_SEMICOLON) {
  1766.                 return FPLERR_MISSING_SEMICOLON;
  1767.               } else
  1768.                 scr->text++;
  1769.               GETMEM(con2, sizeof(struct Condition));
  1770.   
  1771.               con2->check=scr->text;
  1772.               con2->checkl=scr->prg;
  1773.               CALL(Expression(val, scr, CON_GROUNDLVL|CON_SEMICOLON|CON_NUM, NULL));
  1774.   
  1775.               if(*scr->text!=CHAR_SEMICOLON) {
  1776.                 return FPLERR_MISSING_SEMICOLON;
  1777.               } else
  1778.                 scr->text++;
  1779.               con2->postexpr=scr->text;
  1780.               con2->postexprl=scr->prg;
  1781.               {
  1782.                 /*
  1783.                  * Pass the last expression:
  1784.                  */
  1785.                 CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, FALSE));
  1786.               }
  1787.               if(!val->val.val) {
  1788.                 /* We shouldn't enter the loop! Go to end of block:*/
  1789.                 CALL(SkipStatement(scr));
  1790.                 FREE(con2);
  1791.               } else {
  1792.                 CALL(Eat(scr));
  1793.                 scr->text+=(brace=*scr->text==CHAR_OPEN_BRACE);
  1794.                 con2->bracetext=scr->text;
  1795.                 con2->braceprg=scr->prg;
  1796.                 scr->breaks++; /* increase break level */
  1797.                 CALL(Script(scr, val, (brace?SCR_BRACE:0)|SCR_FOR, con2));
  1798.                 FREE(con2);
  1799.                 if(CheckIt(scr, val, control, &ret)) {
  1800.                   CleanUp(scr, control, levels);
  1801.                   return(ret);
  1802.                 }
  1803.               }
  1804.               break;
  1805.             case CMD_RESIZE:
  1806.               CALL(Resize(scr, val, control));
  1807.               break;
  1808.             } /* switch(keyword) */
  1809.           } /* if it wasn't a declaring keyword */
  1810.         } else {
  1811.           declare=FALSE;
  1812.           CALL(Expression(val, scr, CON_ACTION|(prg>=0?CON_IDENT:0), ident));
  1813.           /*
  1814.            * It it returned a string, flush it!
  1815.            */
  1816.           if(val->flags&FPL_STRING && !(val->flags&FPL_NOFREE) && val->val.str) {
  1817.             /* If there was a string return, it should be freed and the
  1818.                string really held a string! */
  1819.             FREE(val->val.str);
  1820.           }
  1821.           /*
  1822.            * Check for semicolon!
  1823.            */
  1824.           if(*scr->text!=CHAR_SEMICOLON)
  1825.             return FPLERR_MISSING_SEMICOLON;
  1826.           else
  1827.             scr->text++;
  1828.         }
  1829.       } /* switch (*scr->text) */
  1830.   
  1831.       if(!(control&(SCR_BRACE|SCR_SWITCH))) {
  1832.         if(control&SCR_LOOP) {
  1833.           CALL(Loop(scr, con, control, &brace));
  1834.           if(brace) {
  1835.             /* Yes! We should loop! */
  1836.             if(control&SCR_BRACE) {
  1837.               /* bring back the proper values */
  1838.               scr->varlevel++;
  1839.               scr->level++;
  1840.               AddLevel(scr); /* restart this level! */
  1841.               declare=TRUE;
  1842.             }
  1843.             scr->virprg=virprg;
  1844.             scr->virfile=virfile;
  1845.             continue;
  1846.           }
  1847.           val->flags=0;
  1848.           ret=FPL_OK;
  1849.           break; /* return to calling function */
  1850.         } else
  1851.           break;
  1852.       }
  1853.     } /* loop! */
  1854.   
  1855.     if(!ret &&
  1856.        control&SCR_FILE &&
  1857.        !scr->prog->foundstart &&
  1858.        !done) {
  1859.       /*
  1860.        * We did get here by hitting end of program.
  1861.        * Let's set the start-of-main position right here to
  1862.        * make another run work fine on this file too!
  1863.        */
  1864.       StoreBeginning(scr, scr->text, scr->prg);
  1865.     }
  1866.  
  1867.   } /* for the if(compiled)-else */
  1868.  
  1869.   /*
  1870.    * Check for that FPLTAG_INTERPRET tag!
  1871.    */
  1872.   if(!ret && scr->interpret) {
  1873.     /* an alternative main program is specified */
  1874.     GETMEM(pass, sizeof(struct fplArgument));
  1875.     pass->ID=FNC_INTERPRET;
  1876.     text = scr->interpret;
  1877.     pass->argv=(void **)&text;
  1878.     pass->key=scr;
  1879.     scr->interpret=NULL; /* disable recursion! */
  1880.     CALL(functions(pass));
  1881.  
  1882.     CleanUp(scr, control, levels);
  1883.  
  1884.     /* we're done for this time, exit! */
  1885.     ret = FPL_EXIT_OK;
  1886.   }
  1887.  
  1888.   CleanUp(scr, control, levels);
  1889.   return(ret);
  1890. }
  1891.  
  1892. static REGARGS void
  1893. StoreBeginning(struct Data *scr, char *text, long prg)
  1894. {
  1895.   scr->prog->startcol=text-(&scr->prog->program)[prg-1];
  1896.   scr->prog->startprg=prg;
  1897.   scr->prog->virprg=scr->virprg;
  1898.   scr->prog->virfile=scr->virfile;
  1899.   scr->prog->foundstart=TRUE;
  1900.  
  1901.   /* fprintf(stderr, "Setexp:%s", text); */
  1902. }
  1903.  
  1904. static ReturnCode INLINE
  1905. Switch(struct Data *scr,
  1906.        struct Expr *val,
  1907.        short control,
  1908.        struct Condition *con)
  1909. {
  1910.   ReturnCode ret;
  1911.   struct fplStr *string;
  1912.   long value;
  1913.   uchar strtype=FALSE;
  1914.   uchar breakout=FALSE;
  1915.  
  1916.   /* temporary storage variables */
  1917.   uchar *ttext;
  1918.   long tprg;
  1919.   uchar *tvirfile;
  1920.   long tvirprg;
  1921.  
  1922.   uchar end=FALSE; /* we have not found the end position */
  1923.  
  1924.   long bprg;
  1925.   uchar *btext;
  1926.   long bvirprg;
  1927.   uchar *bvirfile;
  1928.  
  1929.   long dprg=-1;
  1930.   uchar *dtext;
  1931.   long dvirprg;
  1932.   uchar *dvirfile;
  1933.  
  1934.   CALL(Eat(scr)); /* eat whitespace */
  1935.  
  1936.   /* Check the open parenthesis */
  1937.   if(scr->text[0]!=CHAR_OPEN_PAREN) {
  1938.     return FPLERR_MISSING_PARENTHESES;
  1939.   } else
  1940.     scr->text++;
  1941.  
  1942.   /* Get expression, string or int, static or dynamic! */
  1943.   CALL(Expression(val, scr, CON_NORMAL, NULL));
  1944.  
  1945.   if(val->flags&FPL_STRING) {
  1946.     /* there was a string statement! */
  1947.     string = val->val.str;
  1948.     if(string)
  1949.       strtype=2;
  1950.     else
  1951.       strtype= 1;
  1952.  
  1953.   } else {
  1954.     /* there was an integer expression */
  1955.     value = val->val.val;
  1956.   }
  1957.  
  1958.   /* Check the close parenthesis */
  1959.   if(scr->text[0]!=CHAR_CLOSE_PAREN) {
  1960.     return FPLERR_MISSING_PARENTHESES;
  1961.   } else
  1962.     scr->text++;
  1963.  
  1964.   CALL(Eat(scr)); /* eat whitespace */
  1965.  
  1966.   /* Check the open brace */
  1967.   if(scr->text[0]!=CHAR_OPEN_BRACE) {
  1968.     return FPLERR_MISSING_BRACE;
  1969.   } else
  1970.     scr->text++;
  1971.  
  1972.   while(!(ret=Eat(scr))) {
  1973.     tprg = scr->prg;
  1974.     ttext = scr->text;
  1975.     tvirprg = scr->virprg;
  1976.     tvirfile = scr->virfile;
  1977.     if(!Getword(scr)) {
  1978.       if(!strcmp("case", scr->buf)) {
  1979.         /* This is a valid case-line coming up! */
  1980.  
  1981.         /* Get expression, string or int! */
  1982.         CALL(Expression(val, scr, strtype?CON_STRING:CON_NUM, NULL));
  1983.         if(strtype) {
  1984.           /*
  1985.            * String comparison:
  1986.            */
  1987.           value = val->val.str?val->val.str->len:0;
  1988.  
  1989.           if(value == (string?string->len:0)) {
  1990.  
  1991.             if(value) {
  1992.               if(!memcmp(val->val.str->string, string->string, value)) {
  1993.                 /* match! */
  1994.                 breakout=TRUE;
  1995.               }
  1996.             } else
  1997.               breakout=TRUE;
  1998.           }
  1999.           if(!val->flags&FPL_NOFREE)
  2000.             FREE(val->val.str);
  2001.           if(breakout)
  2002.             break;
  2003.           else
  2004.             scr->text++; /* pass the ';' */
  2005.         } else {
  2006.           /*
  2007.            * Integer comparison:
  2008.            */
  2009.           if(val->val.val == value) {
  2010.             breakout = TRUE;
  2011.             break;
  2012.           } else
  2013.             scr->text++; /* pass the ';' */
  2014.         }
  2015.       } else if(!strcmp("default", scr->buf)) {
  2016.         /*
  2017.          * Store the default position to make it possible to return to if
  2018.          * necessary!
  2019.          */
  2020.  
  2021.     if(dprg>=0)
  2022.       return FPLERR_ILLEGAL_DEFAULT; /* dual 'default' specified! */
  2023.  
  2024.         dprg = scr->prg;
  2025.         dtext = scr->text++; /* pass the colon after the assign */
  2026.         dvirprg = scr->virprg;
  2027.         dvirfile = scr->virfile;
  2028.  
  2029.       } else {
  2030.         /*
  2031.          * Pass the statement!
  2032.          */
  2033.  
  2034.         /* First, restore the previuos position so that we can skip
  2035.            if, while, do and such things without problems! */
  2036.         scr->prg=tprg;
  2037.         scr->text=ttext;
  2038.         scr->virprg=tvirprg;
  2039.         scr->virfile=tvirfile;
  2040.  
  2041.         CALL(SkipStatement(scr));
  2042.       }
  2043.     } else {
  2044.       /* we didn't get any word */
  2045.       if(scr->text[0]==CHAR_CLOSE_BRACE) {
  2046.         /*
  2047.          * We hit the end without finding our 'case'! Return to the
  2048.          * 'default', if any! Store the position to be able to quickly
  2049.          * jump down to it again after the possible case-statement.
  2050.          */
  2051.  
  2052.         scr->text++; /* pass the closing brace */
  2053.         if(dprg<0)
  2054.           /* we didn't find any 'default' */
  2055.           break;
  2056.         bprg = scr->prg;
  2057.         btext = scr->text;
  2058.         bvirprg = scr->virprg;
  2059.         bvirfile = scr->virfile;
  2060.  
  2061.         end=TRUE; /* we have found the end! */
  2062.  
  2063.         scr->prg=dprg;
  2064.         scr->text=dtext;
  2065.         scr->virprg=dvirprg;
  2066.         scr->virfile=dvirfile;
  2067.         breakout = TRUE;
  2068.         break;
  2069.  
  2070.       } else {
  2071.         /*
  2072.          * Pass the statement!
  2073.          */
  2074.         CALL(SkipStatement(scr));
  2075.       }
  2076.     }
  2077.   }
  2078.   if(breakout) {
  2079.     /* we did break out on any of the 'case' or 'default' label lines,
  2080.        pass the colon!
  2081.      */
  2082.     /* CALL(Eat(scr));  eating whitespace shouldn't be necessary here */
  2083.  
  2084.     /* Check the colon */
  2085.     if(scr->text[0]!=CHAR_COLON) {
  2086.       return FPLERR_MISSING_COLON;
  2087.     } else
  2088.       scr->text++;
  2089.  
  2090.     /*
  2091.      * run this statement all the way until break or '}'!
  2092.      */
  2093.  
  2094.     CALL(Script(scr, val, SCR_SWITCH, con));
  2095.  
  2096.     if(!(val->flags&FPL_BRACE)) {
  2097.       /* we didn't run into the closing brace! */
  2098.  
  2099.       if(val->flags&FPL_BREAK) {
  2100.         /*
  2101.          * We got here after hitting a 'break' !!
  2102.          */
  2103.         scr->breaks--; /* decrease break level counter */
  2104.         if(!--val->val.val)
  2105.           val->flags&=~FPL_BREAK; /* only this break and no more ! */
  2106.       }
  2107.  
  2108.       /*
  2109.        * Go to the end of the switch()-statement.
  2110.        */
  2111.       if(!end) {
  2112.         /* we'll have to search for it! */
  2113.         if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE))
  2114.           return FPLERR_MISSING_BRACE;
  2115.       } else {
  2116.         scr->prg=bprg;
  2117.         scr->text=btext;
  2118.         scr->virprg=bvirprg;
  2119.         scr->virfile=bvirfile;
  2120.       }
  2121.     }
  2122.  
  2123.   }
  2124.   return ret;
  2125. }
  2126.  
  2127. static ReturnCode INLINE
  2128. Declare(struct Expr *val,
  2129.     struct Data *scr,
  2130.     struct Identifier *ident,
  2131.     long start)            /* start flags */
  2132. {
  2133.   ReturnCode ret;
  2134.   long flags=start;
  2135.   do {
  2136.     switch(ident->data.external.ID) {
  2137.     case CMD_EXPORT:
  2138.       if(!(scr->flags&FPLDATA_ISOLATE))
  2139.         /* don't do this while running in isolate mode! */
  2140.         flags|=CON_DECLEXP;
  2141.       break;
  2142.     case CMD_STRING:
  2143.       flags|=CON_DECLSTR;
  2144.       break;
  2145.     case CMD_INT:
  2146.       flags|=CON_DECLINT;
  2147.       if(ident->flags&FPL_SHORT_VARIABLE)
  2148.     flags|=CON_DECL16;
  2149.       else if(ident->flags&FPL_CHAR_VARIABLE)
  2150.     flags|=CON_DECL8;
  2151.       break;
  2152.     case CMD_VOID:
  2153.       flags|=CON_DECLVOID;
  2154.       break;
  2155.     case CMD_AUTO:
  2156.     case CMD_REGISTER:
  2157.       /* flags&=~(CON_DECLEXP|CON_DECLGLOB); */
  2158.       break;
  2159.     case CMD_CONST:
  2160.       flags|=CON_DECLCONST;
  2161.       break;
  2162.     case CMD_STATIC:
  2163.       flags|=CON_DECLSTATIC;
  2164.       break;
  2165.     }
  2166.     CALL(Getword(scr));
  2167.     ret=GetIdentifier(scr, scr->buf, &ident);
  2168.   } while(!ret && ident->flags&FPL_KEYWORD_DECLARE);
  2169.  
  2170.   if(!(flags&CON_DECLARE))
  2171.     flags|=CON_DECLINT; /* integer declaration is default! */
  2172.  
  2173.   CALL(Expression(val, scr, CON_GROUNDLVL|flags|CON_IDENT, ident));
  2174.   if(*scr->text!=CHAR_SEMICOLON &&
  2175.      (!(val->flags&FPL_DEFUNCTION) || *scr->text!=CHAR_CLOSE_BRACE)) {
  2176.     return FPLERR_MISSING_SEMICOLON;
  2177.   } else
  2178.     scr->text++;
  2179.   return(FPL_OK);
  2180. }
  2181.  
  2182.  
  2183.  
  2184. /**********************************************************************
  2185.  *
  2186.  * Resize()
  2187.  *
  2188.  * This function resizes a variable array to the new given size.
  2189.  *
  2190.  *****/
  2191.  
  2192. static ReturnCode INLINE Resize(struct Data *scr, struct Expr *val, uchar control)
  2193. {
  2194.   uchar num=0; /* number of dimensions */
  2195.   long *dims; /* dimension array */
  2196.   struct fplVariable *var;
  2197.   struct Identifier *ident;
  2198.   ReturnCode ret;
  2199.   CALL(Getword(scr));
  2200.   CALL(GetIdentifier(scr, scr->buf, &ident));
  2201.   var=&ident->data.variable;
  2202.  
  2203.   if(!(ident->flags&FPL_VARIABLE) || !var->num) {
  2204.     return FPLERR_ILLEGAL_RESIZE;
  2205.   }
  2206.  
  2207.   Eat(scr);
  2208.   GETMEM(dims, MAX_DIMS*sizeof(long));
  2209.  
  2210.   do {
  2211.     if(*scr->text!=CHAR_OPEN_BRACKET) {
  2212.       return FPLERR_MISSING_BRACKET;
  2213.     } else
  2214.       scr->text++; /* pass the open bracket */
  2215.     /* eval the expression: */
  2216.     CALL(Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL));
  2217.     if(*scr->text++!=CHAR_CLOSE_BRACKET)
  2218.       /* no close bracket means error */
  2219.       return(FPLERR_MISSING_BRACKET); /* missing bracket */
  2220.     else if(val->val.val<(control&CON_DECLARE?1:0)) {
  2221.       /* illegal result of the expression */
  2222.       /*
  2223.        * Set back original variable name!
  2224.        */
  2225.       strcpy(scr->buf, ident->name);
  2226.       return(FPLERR_ILLEGAL_ARRAY);
  2227.     }
  2228.     dims[num++]=val->val.val; /* Add another dimension */
  2229.     if(num==MAX_DIMS) {
  2230.       /* if we try to declare too many dimensions... */
  2231.       /*
  2232.        * Set back original variable name!
  2233.        */
  2234.       strcpy(scr->buf, ident->name);
  2235.       return FPLERR_ILLEGAL_ARRAY;
  2236.     }
  2237.     /*
  2238.      * Go on as long there are brackets,
  2239.      */
  2240.   } while(*scr->text==CHAR_OPEN_BRACKET);
  2241.  
  2242.   CALL(ArrayResize(scr, num, dims, ident));
  2243.  
  2244.   FREE(dims);
  2245.   return(FPL_OK);
  2246. }
  2247.  
  2248.  
  2249. ReturnCode REGARGS
  2250. ArrayResize(struct Data *scr,
  2251.             long num,   /* number of new dimensions */
  2252.             long *dims, /* array of new dim sizes */
  2253.             struct Identifier *ident) /* _valid_ variable to resize */
  2254. {
  2255.   long size;
  2256.   long i;
  2257.   long min;
  2258.   void *tempvars;
  2259.   struct fplVariable *var;
  2260.   uchar dynamic=FALSE;
  2261.   var=&ident->data.variable;
  2262.   
  2263.   size=dims[0]; /* array size */
  2264.   for(i=1; i<num; i++)
  2265.     size*=dims[i];
  2266.  
  2267.   min=MIN(size, var->size); /* number of variables to copy! */
  2268.  
  2269.   if(MALLOC_DYNAMIC == TypeMem(ident)) {
  2270.     dynamic = TRUE;
  2271.     GETMEM(tempvars, size * sizeof(void *)); /* data adjust! */
  2272.   }
  2273.   else {
  2274.     GETMEMA(tempvars, size * sizeof(void *)); /* data adjust! */
  2275.   }
  2276.   memcpy(tempvars, var->var.str, min * sizeof(void *));
  2277.   if(size>var->size)
  2278.     /*
  2279.      * If we create a few more than before, empty that data!
  2280.      */
  2281.     memset((uchar *)tempvars+var->size*sizeof(void *), 0,
  2282.        (size-var->size)*sizeof(void *));
  2283.  
  2284.   if(ident->flags&FPL_STRING_VARIABLE)
  2285.     for(i=min; i<var->size; i++) {
  2286.       if(var->var.str[i]) {
  2287.     FREE_KIND(var->var.str[i]);
  2288.       }
  2289.     }
  2290.  
  2291.   FREE_KIND(var->var.val);
  2292.   var->var.val= tempvars;
  2293.  
  2294.   var->size= size;
  2295.   var->num = num;
  2296.   if(var->dims)
  2297.     FREE_KIND(var->dims);
  2298.   if(dynamic) {
  2299.     GETMEM(var->dims, num * sizeof(long));
  2300.   }
  2301.   else {
  2302.     GETMEMA(var->dims, num * sizeof(long));
  2303.   }
  2304.   memcpy(var->dims, dims, num * sizeof(long));
  2305.  
  2306.   return FPL_OK;
  2307. }
  2308.  
  2309. /**********************************************************************
  2310.  *
  2311.  * char CheckIt()
  2312.  *
  2313.  * Returns wether we should return from this Script().
  2314.  *
  2315.  *****/
  2316.  
  2317. static uchar REGARGS
  2318. CheckIt(struct Data *scr, /* major script structure */
  2319.         struct Expr *val, /* result structure */
  2320.         short control,    /* control defines */
  2321.         ReturnCode *ret)  /* return code pointer */
  2322. {
  2323.   if(val->flags&FPL_BREAK) {
  2324.     /*
  2325.      * A `break' was hit inside that Script() invoke.
  2326.      */
  2327.     if(control&SCR_BRACE) {
  2328.       /*
  2329.        * If we're inside braces, search for the close brace!
  2330.        */
  2331.       if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
  2332.     *ret = FPLERR_ILLEGAL_BREAK;
  2333.     return((uchar)*ret);
  2334.       }
  2335.     }
  2336. #ifdef DEBUG_BREAKS
  2337.     fprintf(stderr, "EOS: levels %d line %d, brace? %d bl: %d\n",
  2338.         val->val.val, scr->virprg, control&SCR_BRACE?1:0,
  2339.         scr->breaks);
  2340. #endif
  2341.  
  2342.     if(control&(SCR_LOOP)) {
  2343.       scr->breaks--; /* decrease break level counter */
  2344.       if(control&SCR_DO) {
  2345.         /*
  2346.          * We're inside a do-statement! We must pass the ending "while"
  2347.          * before returning! We do it the easy way: look for the closing
  2348.          * parenthesis!
  2349.          */
  2350.     if(*ret=GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE))
  2351.       return((uchar)*ret);
  2352.         else if(*ret = Eat(scr))
  2353.       return((uchar)*ret);
  2354.         else if(scr->text[0] != CHAR_SEMICOLON) {
  2355.           return FPLERR_MISSING_SEMICOLON;
  2356.         } else
  2357.           scr->text++; /* pass the semicolon */
  2358.       }
  2359.       if(--val->val.val<1)
  2360.     val->flags&=~FPL_BREAK; /* clear the break bit! */
  2361.       return(TRUE);
  2362.     } else if(!(control&SCR_FUNCTION))
  2363.       return(TRUE);
  2364.     else if(val->val.val<2) {
  2365.       val->flags&=~FPL_BREAK; /* clear the break bit! */
  2366.       return(FALSE); /* no more break! */
  2367.     }
  2368.     *ret=FPLERR_ILLEGAL_BREAK;
  2369.     return(TRUE);
  2370.   } else if(val->flags&FPL_RETURN)
  2371.     /* The FPL function did end in a return() */
  2372.     return(TRUE);
  2373.   else if(val->flags&FPL_CONTINUE) {
  2374.     if(control&SCR_LOOP) {
  2375.       if(control&SCR_BRACE) {
  2376.     /* If we're inside braces, search for the close brace */
  2377.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, FALSE)) {
  2378.           *ret = FPLERR_MISSING_BRACE;
  2379.       return((uchar)*ret);
  2380.         }
  2381.     scr->text--; /* move one step back to stand on the close brace */
  2382.     return(FALSE);
  2383.       }
  2384.     } else
  2385.       /* this is not a looping block, break out of it! */
  2386.       return(TRUE);
  2387.   }
  2388.   return(FALSE);
  2389. }
  2390.  
  2391. /**********************************************************************
  2392.  *
  2393.  * CleanUp()
  2394.  *
  2395.  * Deletes/frees all local variable information.
  2396.  *
  2397.  *******/
  2398.  
  2399. void REGARGS
  2400. CleanUp(struct Data *scr,
  2401.         long control,
  2402.         long levels)
  2403. {
  2404.   if(control&(SCR_BRACE|SCR_FUNCTION)) {
  2405.     DelLocalVar(scr, &scr->locals);
  2406.     scr->varlevel--;
  2407.     scr->level=levels; /* new variable amplitude */
  2408.   }
  2409.  
  2410.   if(!(control&SCR_DEBUG)) {
  2411.     /* previous version did not run in debug mode, switch it off! */
  2412.     scr->flags&=~FPLDATA_DEBUG_MODE;
  2413.   }
  2414. }
  2415.  
  2416.  
  2417. /**********************************************************************
  2418.  *
  2419.  * Loop()
  2420.  *
  2421.  * This function is called at the end of a block, however the block was
  2422.  * started (brace or not brace).
  2423.  *
  2424.  *******/
  2425.  
  2426. static ReturnCode REGARGS
  2427. Loop(struct Data *scr,
  2428.      struct Condition *con,
  2429.      short control,
  2430.      uchar *cont) /* store TRUE or FALSE if loop or not */
  2431. {
  2432.   ReturnCode ret = FPL_OK;
  2433.   uchar *temptext=scr->text; /* store current position */
  2434.   long temprg=scr->prg;
  2435.   struct Expr *val;
  2436.  
  2437.   GETMEM(val, sizeof(struct Expr));
  2438.  
  2439.   /*
  2440.    * First check if the block just parsed begun with a while() or for()
  2441.    * or perhaps a do in which we know the statment position!
  2442.    */
  2443.  
  2444.   if((control&SCR_WHILE ||
  2445.       control&SCR_FOR ||
  2446.       (control&SCR_DO && con->check))) {
  2447.     if(control&SCR_FOR) {     /* check if the pre keyword was for() */
  2448.       scr->text=con->postexpr;/* perform the post expression */
  2449.       scr->prg=con->postexprl;
  2450.       CALL(Expression(val, scr, CON_GROUNDLVL|CON_PAREN, NULL));
  2451.     }
  2452.     /*
  2453.      * Do the condition check. The only statement if it was a while() or
  2454.      * do while or the second statement if it was a for().
  2455.      *
  2456.      * If it was a for() as pre statement, the statement could contain
  2457.      * nothing but a semicolon and then equals TRUE.
  2458.      */
  2459.     scr->text=con->check;
  2460.     scr->prg=con->checkl;
  2461.     CALL(Expression(val, scr, CON_GROUNDLVL|
  2462.             (control&SCR_FOR?CON_SEMICOLON:0)|CON_NUM, NULL));
  2463.  
  2464.     if(val->val.val) { /* the result of the condition was true */
  2465.       scr->text=con->bracetext; /* return to the open brace */
  2466.       scr->prg=con->braceprg;
  2467.       *cont=TRUE;
  2468.       FREE(val);
  2469.       return(FPL_OK);
  2470.     }
  2471.   }
  2472.  
  2473.   if(control&SCR_DO) {
  2474.     /* This a do while end. */
  2475.  
  2476.     if(!con->check) {
  2477.       /*
  2478.        * We *DON'T* know the condition position. We have to scan forward
  2479.        * to get it!
  2480.        */
  2481.       if(*scr->text==CHAR_CLOSE_BRACE)
  2482.     /* pass the close brace */
  2483.     scr->text++;
  2484.       if(ret=Getword(scr))
  2485.     ;
  2486.       else if(strcmp(scr->buf, "while"))
  2487.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2488.       else if(ret=Eat(scr))
  2489.     ;
  2490.       else if(*scr->text++!=CHAR_OPEN_PAREN)
  2491.     ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2492.       else {
  2493.     con->check=scr->text;
  2494.     con->checkl=scr->prg;
  2495.     if(ret=Expression(val, scr, CON_GROUNDLVL|CON_NUM, NULL))
  2496.       ;
  2497.     else if(*scr->text++!=CHAR_CLOSE_PAREN)
  2498.       ret=FPLERR_MISSING_PARENTHESES; /* >warning< */
  2499.       }
  2500.       if(ret)
  2501.     return(ret);
  2502.     }
  2503.     if(!val->val.val) {
  2504.       /*
  2505.        * If we had the check point up there and the condition equaled
  2506.        * FALSE. Now we have to pass the the while keyword following the
  2507.        * close brace.
  2508.        */
  2509.       scr->text=temptext;
  2510.       scr->prg=temprg;
  2511.  
  2512.       if(*scr->text==CHAR_CLOSE_BRACE)
  2513.     /* pass the close brace */
  2514.     scr->text++;
  2515.  
  2516.       if(Getword(scr) || strcmp("while", scr->buf))
  2517.     ret=FPLERR_MISSING_WHILE; /* missing 'while' after do-while statement */
  2518.       else if(GetEnd(scr, CHAR_SEMICOLON, (uchar)255, FALSE))
  2519.     ret = FPLERR_MISSING_SEMICOLON;
  2520.       if(ret)
  2521.     return(ret);
  2522.     } else {
  2523.       /* go to the open brace */
  2524.       scr->text=con->bracetext;
  2525.       scr->prg=con->braceprg;
  2526.       *cont=TRUE;
  2527.       FREE(val);
  2528.       return(FPL_OK);
  2529.     }
  2530.   }
  2531.  
  2532.   FREE(val);
  2533.  
  2534.   /*
  2535.    * The condition check has failed!
  2536.    */
  2537.  
  2538.   *cont=FALSE;
  2539.  
  2540.   if(!(control&SCR_DO)) {
  2541.     /* it's not a do-while loop */
  2542.  
  2543.     scr->text=temptext;
  2544.     scr->prg=temprg;
  2545.  
  2546.     Eat(scr);
  2547.  
  2548.     if(control&SCR_BRACE && *scr->text==CHAR_CLOSE_BRACE)
  2549.       /* pass the close brace */
  2550.       scr->text++;
  2551.   }
  2552.  
  2553.   return(ret);
  2554. }
  2555.  
  2556. /**********************************************************************
  2557.  *
  2558.  * ReturnCode SkipStatement();
  2559.  *
  2560.  *  This function should pass one statement. Statements starting with
  2561.  * "for", "do", "while" or "if" really can be meesy and in such cases
  2562.  * this function recurse extensively!!!
  2563.  *
  2564.  ******/
  2565.  
  2566. static ReturnCode REGARGS
  2567. SkipStatement(struct Data *scr)
  2568. {
  2569.   ReturnCode ret;
  2570.   struct Identifier *ident;
  2571.   CALL(Eat(scr));
  2572.  
  2573.   if(*scr->text==CHAR_SEMICOLON)
  2574.     scr->text++;
  2575.   else if(*scr->text==CHAR_OPEN_BRACE) {
  2576.     if(GetEnd(scr, CHAR_CLOSE_BRACE, CHAR_OPEN_BRACE, TRUE))
  2577.       return FPLERR_MISSING_BRACE;
  2578.   } else {
  2579.     /*
  2580.      * Much more trouble this way:
  2581.      */
  2582.  
  2583.     uchar *t;
  2584.     long p;
  2585.  
  2586.     ret = Getword(scr);
  2587.     if(!ret) {
  2588.       GetIdentifier(scr, scr->buf, &ident);
  2589.       switch(ident?ident->data.external.ID:0) {
  2590.       case CMD_IF:
  2591.       case CMD_WHILE:
  2592.         Eat(scr);
  2593.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2594.         CALL(SkipStatement(scr));
  2595.     CALL(Eat(scr));
  2596.         t=scr->text;
  2597.         p=scr->prg;
  2598.  
  2599.         if(!Getword(scr) && !strcmp(KEYWORD_ELSE, scr->buf)) {
  2600.           CALL(SkipStatement(scr));
  2601.         } else {
  2602.           /*
  2603.            * Restore pointers.
  2604.            */
  2605.           scr->text=t;
  2606.           scr->prg=p;
  2607.         }
  2608.         break;
  2609.       case CMD_FOR:
  2610.       case CMD_SWITCH:
  2611.         Eat(scr);
  2612.         /* Now we must stand on an open parenthesis */
  2613.         CALL(GetEnd(scr, CHAR_CLOSE_PAREN, CHAR_OPEN_PAREN, TRUE));
  2614.         CALL(SkipStatement(scr));
  2615.         break;
  2616.       case CMD_DO:
  2617.         Eat(scr);
  2618.         CALL(SkipStatement(scr));
  2619.  
  2620.         /*
  2621.          * The next semicolon must be the one after the
  2622.          * following `while' keyword!
  2623.          */
  2624.         if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  2625.           return FPLERR_MISSING_SEMICOLON;
  2626.         break;
  2627.       default:
  2628.         ret=TRUE;
  2629.       }
  2630.     }
  2631.     if(ret) {
  2632.       /*
  2633.        * This statement ends at the next semicolon
  2634.        */
  2635.       if(GetEnd(scr, CHAR_SEMICOLON, 255, FALSE))
  2636.         return FPLERR_MISSING_SEMICOLON;
  2637.     }
  2638.   }
  2639.   return(FPL_OK);
  2640. }
  2641.  
  2642. #ifdef UNIX
  2643. long InterfaceCall(struct Data *scr,
  2644.            void *arg,
  2645.            long (*func)(void *))
  2646. {
  2647.   return func(arg);
  2648. }
  2649. #endif
  2650.